cjw

Sub ¬d§ä()
Dim xR%, xY%, zR%, j%, xC%
Set SH1 = Sheet1
Set SH2 = Sheet2
xR = SH1.Cells(Rows.Count, "A").End(3).Row
xY = SH1.Cells(1, Columns.Count).End(xlToLeft).Column
Ar = SH1.Cells(1, 1).Resize(xR, xY)
zR = SH2.Cells(Rows.Count, "A").End(3).Row
With SH2
For j = 2 To zR
xC = SH1.Rows(1).Find(.Cells(j, "B")).Column
.Cells(j, "C") = Application.VLookup(.Cells(j, "A"), Ar, xC, 0)
Next
End With
End Sub