Sub Ex()
Set d = CreateObject("Scripting.Dictionary")
With Sheets(2)
For Each a In .Range(.[A1], .[A65536].End(xlUp))
d(a.Value) = a.Offset(, 1)
Next
With Sheets(1)
For Each a In .Range(.[A1], .[A65536].End(xlUp))
a.Offset(, 3) = d(a.Value)
Next
End With
End With
End Sub