Try this...
Sub search()
Dim listVals As Variant
Dim dataVals As Variant
Dim i As Long, j As Long, k As Long
listVals = Sheets("Sheet1").Range("A1").CurrentRegion.Resize(, 14).Value
dataVals = Sheets("Sheet2").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
For i = LBound(listVals, 1) To UBound(listVals, 1)
.Item(listVals(i, 1)) = i
Next i
For i = LBound(dataVals, 1) To UBound(dataVals, 1)
If .Exists(dataVals(i, 1)) Then
j = .Item(dataVals(i, 1))
For k = 1 To 7
listVals(j, k + 7) = dataVals(i, k)
Next k
End If
Next i
Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(listVals, 1), 14).Value = listVals
End With
End Sub
Bookmarks