Update Data from Multiple Worksheet Using VBA

Let's take there are two files:"Patients.xls & "Report.xls" In first file we collate data for multiple patients(PatientId) monthwise.

In second file we extract data from software for all patients(PatientId) monthwise.

So if there are large no. of patients,it's very difficult to update all monthly data from Report file to Patient file. So here
is the VBA code for update data in Patients.xls from multiple worksheets of Report.xls.

Sub fillRecord()
Dim sheetcount As Integer
Dim filename, sourcemonth As String
Dim wkbook As Workbook
Dim Id, sourceWBC, sourceSodium, sourcePotassium, lookupMonth As Range
On Error Resume Next
filename = "C:\Users\abc\Desktop\vbacodetoupdatedatainmultiplesheet\Report.xls"
sheetcount = Workbooks("Patients.xls").Sheets.Count
Set wkbook = Workbooks.Open(filename)
sourcemonth = Workbooks("Report.xls").Sheets(1).Range("B1").Value
Set Id = Workbooks("Report.xls").Sheets(1).Cells.Find("PatientId", LookIn:=xlValues, lookat:=xlWhole)
Set sourceWBC = Id.EntireRow.Cells.Find("WBC", LookIn:=xlValues, lookat:=xlWhole)
Set sourceSodium = Id.EntireRow.Cells.Find("Sodium", LookIn:=xlValues, lookat:=xlWhole)
Set sourcePotassium = Id.EntireRow.Cells.Find("Potassium", LookIn:=xlValues, lookat:=xlWhole)
For i = 1 To sheetcount
Set lookupMonth = Workbooks("Patients.xls").Sheets(i).Cells.Find(sourcemonth, LookIn:=xlValues, lookat:=xlWhole)
For j = 1 To 3
If Workbooks("Patients.xls").Sheets(i).Name = CStr(Id.Offset(j, 0).Value) Then
lookupMonth.Offset(1, 0).Value = sourceWBC.Offset(j, 0).Value
lookupMonth.Offset(2, 0).Value = sourceSodium.Offset(j, 0).Value
lookupMonth.Offset(3, 0).Value = sourcePotassium.Offset(j, 0).Value
End If
Next j
Next i
End Sub