Speed up Macro

[Fluff]

Another option

Sub LookupCopy()
   Dim InAry As Variant, Oary As Variant
   Dim i As Long
   
   With Sheets("sheet1")
      InAry = .Range("A1", .Range("A" & Rows.Count).End(xlUp).Offset(, 1))
   End With
   With Sheets("sheet2")
      Oary = .Range("A1", .Range("A" & Rows.Count).End(xlUp).Offset(, 1))
   End With
   With CreateObject("scripting.dictionary")
      For i = 1 To UBound(InAry)
         .Item(InAry(i, 1)) = InAry(i, 2)
      Next i
      For i = 1 To UBound(Oary)
         Oary(i, 2) = .Item(Oary(i, 1))
      Next i
   End With
   Sheets("sheet2").Range("B1").Resize(UBound(Oary)).Value = Application.Index(Oary, 0, 2)
End Sub