Copying Data from Another Excel Workbook Based on Criteria -- Part 2 :)

[johnellis1971200]

Microsoft Excel's Workbook 1 has data in cell A3 and J3.

Likewise, Workbook 2 has data in cells A2 and B2.

I need to devise (or modify within a VBA script) a macro to copy data from A2 in Workbook 2 to A3 in Workbook 1, as long as cell B2 in Workbook 2 matches cell J3 in Workbook 1.

To give a little more background, column A in both workbooks is a document number.  Column B in Workbook 2 and column J in Workbook 1 is an Employee ID.

Workbook 1 has "Document No.", while Workbook 2 has "No.".

Likewise, Workbook 1 has "Payroll Employee No." and Workbook 2 has "Employee No.".

I want to emphasize that these are two separate workbooks -- not two separate spreadsheets on two tabs of the same workbook.

Someone gave me the code below.  It works perfectly!

But, I just found out that it needs to be modified to work no matter how many rows of "Payroll Employee No." exist in Workbook 1.

For example, if Workbook 1 has two of that "Payroll Employee No.", then two of  "Document No." need to be copied to Workbook 1 from Workbook 2.

Would someone please help me modify this code?  Thanks!

Sub CopyDataBetweenWorkbooks()
    ' Declare variables
    Dim sourceWorkbook As Workbook, targetWorkbook As Workbook
    Dim sourceSheet As Worksheet, targetSheet As Worksheet
    Dim No As String, EmployeeNo As String
    Dim matchCell As Range, i As Long, lastRowSource As Long, lastRowTarget As Long
 
 
    ' Set references to source and target workbooks
    Set sourceWorkbook = Workbooks("Payroll Processing.xlsx")
    Set targetWorkbook = Workbooks("Job Journals.xlsx")
 
 
    ' Set references to source and target sheets
    Set sourceSheet = sourceWorkbook.Sheets(1)
    Set targetSheet = targetWorkbook.Sheets(1)
 
 
    ' Find the last row with data in column A of both workbooks
    lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    lastRowTarget = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
 
 
    ' Loop through each row in the source workbook
    For i = 2 To lastRowSource
        ' Get document number and employee ID from source workbook
        No = sourceSheet.Cells(i, 1).Value
        EmployeeNo = sourceSheet.Cells(i, 2).Value
 
 
        ' Find the matching row in the target workbook based on employee ID
        Set matchCell = targetSheet.Columns(10).Find(EmployeeNo, LookIn:=xlValues, LookAt:=xlWhole)
 
 
        ' If a match is found, copy data from source to target workbook
        If Not matchCell Is Nothing Then targetSheet.Cells(matchCell.Row, 1).Value = No
    Next i
End Sub

[#2 · Accepted solution]

@johnellis1971200 Try the procedure in reverse, where you loop through the rows in the target worksheet instead:

Sub CopyDataBetweenWorkbooks()
'Declare variables
    Dim sourceWorkbook As Workbook, targetWorkbook As Workbook
    Dim sourceSheet As Worksheet, targetSheet As Worksheet
    Dim lastRow As Long, i As Long, rowId As Variant

'Set references to the source and target workbooks
    Set sourceWorkbook = Workbooks("Payroll Processing.xlsx")
    Set targetWorkbook = Workbooks("Job Journals.xlsx")

'Set references to the source and target worksheets
    Set sourceSheet = sourceWorkbook.Sheets(1)
    Set targetSheet = targetWorkbook.Sheets(1)

'Find the last row with data in the Employee ID column of the target worksheet
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, 10).End(xlUp).Row

'Loop through each row in the target worksheet
    For i = 3 To lastRow
    ' find the matching row in the source worksheet based on employee ID
        rowId = Application.Match(targetSheet.Cells(i, 10).Value, sourceSheet.Columns(2), 0)
    
    ' if a match is found, copy data from source to target worksheet
        If Not IsError(rowId) Then targetSheet.Cells(i, 1).Value = sourceSheet.Cells(rowId, 1).Value
    Next i
End Sub

Note: Application.Match was used in this example instead of the Range.Find method.