Sub Transfert()
Dim cel As Range, cel1 As Range
For Each cel In Sheets("Feuil1").Range("B1:B" & Sheets("Feuil1").Range("B65536").End(xlUp).Row)
Set cel1 = Sheets("Feuil2").Range("A:A").Find(cel, LookIn:=xlFormulas, LookAt:=xlWhole)
If Not cel1 Is Nothing Then cel.Offset(0, -1) = cel1.Offset(0, 1)
Next
End Sub