Macro Excel to copy range cells from one sheet to another based on cell match and skip cell if no match

Question

I am new to macros in excel and I am trying to create one that will help me to copy data from cells from one sheet to another based on matching. Basically I want excel to look into Column H from Sheet1 and if data from any cell will match data from any cell in Column E from Sheet2, it will copy a column range from Sheet1 to Sheet2 to the relevant row (where the matching was found).

For example: If data from H5 (sheet1) matches data from E1 (sheet2) than cells I5 to J5 (sheet1) should be copied to cells F1 to G1.

Currently I have this macro which is doing part of the job:

Sub asd()
For Counter = 1 To 10
    If Sheets(1).Range("H" & Counter).Value = Sheets(2).Range("E" & Counter).Value Then
        Sheets(2).Range("F" & (Counter)).Value = Sheets(1).Range("I" & Counter).Value
        Sheets(2).Range("G" & (Counter)).Value = Sheets(1).Range("J" & Counter).Value
    End If
Next Counter
End Sub

The problem with it is that as soon as there is no match between column H (sheet1) to column E (Sheet2) the macro stops. I am sure there is a simple way to make it jump to the next row if there is no match until all rows are done.

Can anyone edit this code to make it work?

Answer 1

Working under the assumption that you want your code to run for more than the first 10 lines of the two sheets, give this a try:

Sub asd()
'this runs through all used rows in sheet 1
For Counter = 1 To Sheets(1).UsedRange.Rows.Count  
  'this ensures that cell H<row> has a non-blank value
  'you can leave this If statement out if you know there will be no blanks in Column H
  If sheets(1).Range("H" & counter) <> "" then  
    If Sheets(1).Range("H" & Counter).Value = Sheets(2).Range("E" & Counter).Value Then
      Sheets(2).Range("F" & (Counter)).Value = Sheets(1).Range("I" & Counter).Value
      Sheets(2).Range("G" & (Counter)).Value = Sheets(1).Range("J" & Counter).Value
    End If
  End if
Next Counter
End Sub

Answer 2

You need 2 loops to compare the value from Sheet1 with all others in Sheet2 :

    Sub asd()

    Dim lngLastRowSht1 As Long
    Dim lngLastRowSht2 As Long
    Dim counterSht1 As Long
    Dim counterSht2 As Long

    With Worksheets(1)
        lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
        lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
            For counterSht1 = 1 To lngLastRowSht1
                For counterSht2 = 1 To lngLastRowSht2
                    If .Cells(counterSht1, 8) = Worksheets(2).Cells(counterSht2, 5) Then
                        Worksheets(2).Cells(counterSht2, 6) = .Cells(counterSht1, 9)
                        Worksheets(2).Cells(counterSht2, 7) = .Cells(counterSht1, 10)
                    End If
                Next counterSht2
            Next counterSht1
    End With

End Sub

Answer 3

Great guys! Both codes are working perfectly.

There is one more thing I would need to add to it. How can I define a range of column that need to be copied? For e.g. instead of having this lines twice:

Sheets(2).Range("F" & (Counter)).Value = Sheets(1).Range("I" & Counter).Value
Sheets(2).Range("G" & (Counter)).Value = Sheets(1).Range("J" & Counter).Value

Or this twice

Worksheets(2).Cells(counterSht2, 6) = .Cells(counterSht1, 9)
Worksheets(2).Cells(counterSht2, 7) = .Cells(counterSht1, 10)

How can I define "I want all columns between I and AL (sheet 1) to be copied to all columns between F to AI (sheet 2)"? I have to work with 500 columns and will take a lot of time to do one line for each.

Thanks a lot!

Mihai

Answer 4

I have combined the two suggestions offered by FreeMan and Branislav Kollár and come up with a code that is working to also select a larger range to be copied. If anyone wants this in the future, please see below the code I got:

Sub CopyCells()

Dim lngLastRowSht1 As Long
Dim lngLastRowSht2 As Long
Dim counterSht1 As Long
Dim counterSht2 As Long

With Worksheets(1)
    lngLastRowSht1 = .Cells(.Rows.Count, 8).End(xlUp).Row
    lngLastRowSht2 = Worksheets(2).Cells(Worksheets(2).Rows.Count, 5).End(xlUp).Row
        For counterSht1 = 1 To lngLastRowSht1
            For counterSht2 = 1 To lngLastRowSht2
                If Sheets(1).Range("H" & (counterSht1)).Value = Sheets(2).Range("E" & counterSht2).Value Then
                    Sheets(2).Range("F" & (counterSht2), "H" & (counterSht2)).Value = Sheets(1).Range("I" & counterSht1, "K" & counterSht1).Value
                End If
            Next counterSht2
        Next counterSht1
End With
End Sub

Thanks!

Mihai