Forum Discussion

johnellis1971200's avatar
johnellis1971200
Copper Contributor
Jan 25, 2024
Solved

Microsoft Excel Macro for Copying Data from Another Workbook Based on Criteria

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 Workboo...
  • HansVogelaar's avatar
    Jan 25, 2024

    johnellis1971200 

    1) Variable names cannot contain spaces and periods.

    2) Workbook(...) should be Workbooks(...)

    3) The variable i has not been declared.

     

    Try this version (I haven't tested it):

    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, lastRowSource As Long, lastRowTarget As Long
        Dim i 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(2).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

Resources