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

Question

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.&nbsp;To give a little more background, column A in both workbooks is a document number. &nbsp;Column B in Workbook 2 and column J in Workbook 1 is an Employee ID.&nbsp;Workbook 1 has "Document No.", while Workbook 2 has "No.".&nbsp;Likewise, Workbook 1 has "Payroll Employee No." and Workbook 2 has "Employee No.".&nbsp;I want to emphasize that these are two separate workbooks -- not two separate spreadsheets on two tabs of the same workbook.&nbsp;Someone gave me the code below. &nbsp;It works perfectly!&nbsp;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.&nbsp;For example, if Workbook 1 has two of that "Payroll Employee No.", then two of &nbsp;"Document No." need to be copied to Workbook 1 from Workbook 2.&nbsp;Would someone please help me modify this code? &nbsp;Thanks!&nbsp;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

djclements · Accepted Answer

johnellis1971200&nbsp;Try the procedure in reverse, where you loop through the rows in the target worksheet instead:&nbsp;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&nbsp;Note: Application.Match was used in this example instead of the Range.Find method.

Forum Discussion

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

Share

Resources