Search for same values in sheet1 and sheet2 and copy the values from sheet1 to sheet2

Question

I have worked along time with excel but aren't very good at VBA, so I need help to make an macro and I cant get a recording macro to work :(

I have an excel file with 2 sheets (Sheet1 and Sheet2).

I want to compare a text from Sheet2 (column A) with sheet1 (column B) and if it finds same text in both sheets so do I want the macro to copy column A,B,C and D from sheet1 over to column B,C,D and E in sheet2.

In sheet 1 I have more than 6000 rows so I don't want to do this manually or do a formula in excel, I want a macro that does this for me.

The sheets have headers, can someone maybe help me with this ?

Answer 1

I'm a little unclear on what you are trying to do. This is my interpretation: suppose that, for a value in row X column A on sheet 1 -- if you find a corresponding value on sheet 2 in row Y column B -- you want to copy from sheet 1 the cells on row X belonging to columns ABCD and paste them on sheet 2 in row Y columns BCD E.

If that is correct, try this:

Sub copyCells()
    Dim wb As Workbook, firstWs As Worksheet, secondWs As Worksheet
    Dim matchIndex As Integer

    Set wb = ThisWorkbook
    Set firstWs = wb.Worksheets(1)
    Set secondWs = wb.Worksheets(2)

    Application.ScreenUpdating = False

    ' We'll start at i=2 to account for the header
    For i = 2 To firstWs.Range("A2:A6000").Rows.count
        On Error Resume Next
        ' MATCH will find the row number in sheet 2 - change the range specifications as needed
        matchIndex = Application.WorksheetFunction.Match(firstWs.Range("A" & i), secondWs.Range("B2:B6000"), 0)
        Err.Clear
        On Error GoTo 0

        ' MATCH will throw an error if it finds no results.
        ' Hence: if matchindex contains an error, do nothing.
        ' But if it doesn't contain an error, it must contain a row number - so we can proceed.
        If Not Application.WorksheetFunction.IsNA(matchIndex) Then
            secondWs.Range("B" & matchIndex).Value = firstWs.Range("A" & i).Value
            secondWs.Range("C" & matchIndex).Value = firstWs.Range("B" & i).Value
            secondWs.Range("D" & matchIndex).Value = firstWs.Range("C" & i).Value
            secondWs.Range("E" & matchIndex).Value = firstWs.Range("D" & i).Value    
        End If
    Next i

    Application.ScreenUpdating = True
End Sub