Macro for lookup

try

Sub ertert44()
Dim x, i&, j&, ubx&
With Sheets("Sheet2")
    x = .Range("A1:BK" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ubx = UBound(x, 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
        For j = 1 To ubx
            If Len(x(i, j)) Then .Item(x(i, j)) = x(i, ubx)
        Next j
    Next i
    With Sheets("Sheet1")
        x = .Range("B4", .Cells(Rows.Count, 2).End(xlUp)).Value
    End With
    For i = 1 To UBound(x)
        If Not .Exists(x(i, 1)) Then x(i, 1) = "" Else x(i, 1) = .Item(x(i, 1))
    Next i
End With
Sheets("Sheet1").Range("D4").Resize(i - 1).Value = x
End Sub