Snasui Excel Forum

Code: Select all

Sub Test()
    Dim rAll As Range, l As Long
    Dim rTarget As Range, rt As Range
    l = Rows.Count
    With Sheets("List")
        Set rAll = .Range("A1", .Range("A" & l).End(xlUp))
    End With
    With Sheets("Name")
        Set rTarget = .Range("A1", .Range("A" & l).End(xlUp))
    End With
    For Each rt In rTarget
        If Application.CountIf(rAll, rt) > 0 Then
            rt = rAll(Application.Match(rt, rAll, 0)).Offset(0, 1)
        End If
    Next rt
End Sub