How to copy data from multiple worksheet into one using Employee ID as identifier

Question

I am very new to Excel and macros.

I have a file with Employee data scattered over multiple worksheet in the same file. I want to search employee number in each of the sheets starting with sheet "Data Source 1" and copy all data in each row against employee ID to "Combined Data" sheet.

Next I want to search same employee ID in sheet "Data Source 2" and copy information if available to "Combined Sheet" in specified column, if information is not available search for same Employee ID in "Data Source 3" and copy data to combined sheet again in specified column only.

If it is not present then loop again start with search for new employee ID from "data source 1" sheet.

I am stuck and not able to understand how to move ahead.

Code currently being used:

Sub Search_cell()
    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer
    
    On Error GoTo Err_Execute
    
    'Start search in row 3
    LSearchRow = 3
    
    'Start copying data to row 2 in Sheet Combined_data (row counter variable)
    LCopyToRow = 2
    
    Sheets("Data source 1").Select
    
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0
    
       'If value in column A = "123", copy entire row to sheet Combined_data
       If Range("A" & CStr(LSearchRow)).Value = "123" Then
    
          'Select row in Sheet Data Source 1 to copy
          Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
          Selection.Copy
    
          'Paste row into Sheet Combined_data in next row
          Sheets("Combined_data").Select
          Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
          ActiveSheet.Paste
    
          'Move counter to next row
          LCopyToRow = LCopyToRow + 1
    
          'Go back to Sheet1 to continue searching
          Sheets("Data source 1").Select
    
       End If
    
       LSearchRow = LSearchRow + 1
    
    Wend
    
    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select
    
    MsgBox "All matching data has been copied."
    
    Exit Sub
    
Err_Execute:
    MsgBox "An error occurred."
    
    
End Sub

Issues :

1. I have to manually Provide Ideantifier example "123" to be searched, I want it to take directly by going to next row in Sheet "Data Source 1"

2. This code copies and pastes entire row of data where Match occurs, instead I want to paste data From Sheet "Data Source 2" into column E to H in "Combined_data" sheet.

3. I dont understand how can I replicate the same process for sheet Data Source 2, Data Source 3.

Answer 1

Please try the following code.

Also rectify your sheet name from 'Date Source 1' to 'Data Source 1'

Sub CombineData()
    
    Dim dataRng1 As Range, dataRng2 As Range, dataRng3 As Range
    Dim searchRng As Range, lrow As Long, combRng As Range
        
        Set dataRng1 = Worksheets("Data source 1").Range("A3", Worksheets("Data source 1").Range("D" & Rows.Count).End(xlUp))
        Set dataRng2 = Worksheets("Data source 2").Range("A3", Worksheets("Data source 2").Range("E" & Rows.Count).End(xlUp))
        Set dataRng3 = Worksheets("Data source 3").Range("A3", Worksheets("Data source 3").Range("D" & Rows.Count).End(xlUp))
        
        lrow = Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Row
        
        Set searchRng = Worksheets("Combined").Range("A2", Worksheets("Combined").Range("A2").End(xlDown))
        Set combRng = Worksheets("Combined").Range("A3", Worksheets("Combined").Range("K" & lrow))
        
        combRng.Cells.Clear
    
    Dim rw As Range, destRow As Long
    
        For Each rw In dataRng1.Rows
        
            rw.Copy Worksheets("Combined").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            
        Next rw
        
        For Each rw In dataRng2.Rows
            
            If Not searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole) Is Nothing Then
                destRow = searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole).Row
                rw.Offset(0, 1).Resize(, rw.Columns.Count - 1).Copy Worksheets("Combined").Range("E" & destRow, "H" & destRow)
            End If
            
        Next rw
        
        For Each rw In dataRng3.Rows
        
            If Not searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole) Is Nothing Then
                destRow = searchRng.Find(What:=rw.Cells(1, 1).Value, LookAt:=xlWhole).Row
                rw.Offset(0, 1).Resize(, rw.Columns.Count - 1).Copy Worksheets("Combined").Range("I" & destRow, "K" & destRow)
            End If
            
        Next rw
    
End Sub