Sub Test()
Dim a, x, ws As Worksheet, sh As Worksheet, i As Long
Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set sh = ThisWorkbook.Worksheets("Sheet2")
a = sh.Range("A2:A" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim b(1 To UBound(a, 1), 1 To 3)
For i = LBound(a) To UBound(a)
x = Application.Match(a(i, 1), ws.Columns(3), 0)
If Not IsError(x) Then
b(i, 1) = ws.Cells(x, 1).Value
b(i, 2) = ws.Cells(x, 2).Value
b(i, 3) = ws.Cells(x, 4).Value
Else
b(i, 1) = Empty: b(i, 2) = Empty: b(i, 3) = Empty
End If
Next i
sh.Range("C2:E" & Rows.Count).ClearContents
sh.Range("C2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
Application.ScreenUpdating = True
End Sub