How to copy and paste a range to another worksheet by matching a cell value

Question

I need to copy a range from one worksheet to another worksheet by matching the value in a cell to the row in the other sheet with that value. For instance, I need to copy the range E2:H2 on sheet1 by matching the value in cell A2 (sheet1) to the row on sheet2 that has matching cell value. For example, in my images below sheet1 has an ID of 10 and some data. Columns E2:H2 should get copied to the row on sheet2 that has ID 10.

Sheet1 example (source of data)

Sheet2 example (Target of data)

This will be part of a much larger code that calls in this sub, and I made an example instead of using the actual spreadsheet, becuase of size of data.

Here is some modified code that would be very similar to what i have currently for this piece of the code (changed range and sheets names). I know what i have for pasteing would not do what i want, but could not find something similar to what i need. Thanks!

sub copydata()
    'Range of cells to be copied to other sheet
    Const strRANGE as String = "E2:H2"

    set shSource=Sheets("Sheet1")
    set shTarget=Sheets("Sheet2")

    'Copy range from source sheet (sheet1)
    shSource.Range(strRANGE).copy

    'Paste range from Source sheet(sheet1) to Sheet 2 by matching ID value (cell A2)
     shTarget.Range("A65000").End(xlUp).Offset(1).PasteSpecial xlValues

end sub

Answer 1

Something like this will work, you can leverage the Range.Find function to locate the ID in Target sheet.

Sub copydata()

Set shSource = Sheets("Sheet1")
Set shTarget = Sheets("Sheet2")

Dim fnd As Range

Set fnd = shTarget.Range("A1:A1000").Find(shSource.Range("A2").Value)

   If Not fnd Is Nothing Then
        shSource.Range("E2:H2").Copy
        shTarget.Cells(fnd.row, 5).PasteSpecial xlPasteValues
    End If

End Sub

Currently it will work for 2nd row only, put it in a loop for multiple rows.