Conditional copy from one worksheet to another, based on values in key columns

[svendfj]

Hello,

My scouring of previous posts somehow has not turned up something close to what I am looking for. Thanks in advance for any guidance you can please lend.

A simplified version: I have a 'Master' worksheet that has IDs listed in column A, starting at row 2. In 'Sheet2' of the same workbook, column G has a subset of the same IDs, and then columns H, I and J have 'Color', 'Taste' and 'Smell', respectively. I want to:
(a) loop through the IDs in Column A in 'Master', and
(b) for each ID, I want to loop through Column G of 'Sheet2', and
(c) when there is a match, I want to copy the information on that row - in Columns H, I and J - and copy that information into Columns B, C and D of the row with that ID in 'Master'.

Thank you for any leads! Sven

 

[Takae]

Hope this helps.

Sub test()
 Dim rng As Range, c, cnt As Long
 Dim Mws As Worksheet, ws2 As Worksheet
 Dim r As Long
 
 Set Mws = Sheets("Master")
 Set ws2 = Sheets("Sheet2")
 cnt = 2
 With Mws
    Set rng = ws2.Range(ws2.Range("G2"), ws2.cells(Rows.count, 7).End(xlUp))
    For Each c In .Range(.Range("A2"), .cells(Rows.count, 1).End(xlUp))
        r = 0
        On Error Resume Next
        r = WorksheetFunction.match(c, rng, 0)
        On Error GoTo 0
        If r <> 0 Then
            .Range(.cells(cnt, 2), .cells(cnt, 4)).Value = ws2.Range(ws2.cells(r + 1, 8), ws2.cells(r + 1, 10)).Value
        End If
        cnt = cnt + 1
    Next
 End With
 End Sub

 

[Takae]

no loop

 Sub test()
 Dim LR As Long
 With Sheets("Master")
    LR = .cells(Rows.count, 1).End(xlUp).Row
    .Range(.Range("B2"), .cells(LR, 4)).FormulaR1C1 = "=VLOOKUP(RC1,Sheet2!C7:C10,COLUMN(),0)"
    .Range(.Range("B2"), .cells(LR, 4)).Value = .Range(.Range("B2"), .cells(LR, 4)).Value
 End With
 End Sub

 

[svendfj]

Thank you very much Takae!