Sub es()
Dim t(), i As Long, m As Object, s As Long, r As Long, c As Long, s as long
With Application: .ScreenUpdating = 0: .DisplayAlerts = 0: .EnableEvents = 0: .Calculation = 0: End With
s = Timer
r = Feuil2.Cells(Rows.Count, 1).End(3).Row
c = Feuil2.Cells(Rows.Count, 3).End(3).Row + 1
Set m = CreateObject("Scripting.Dictionary")
t = Feuil2.Range("a" & c & ":a" & r)
For i = 1 To UBound(t): m(t(i, 1)) = "": Next i
t = Feuil1.Range("a2:b" & Feuil1.Cells(Rows.Count, 1).End(3).Row)
For i = 1 To UBound(t)
If m.Exists(t(i, 1)) Then m(t(i, 1)) = t(i, 2)
Next i
t = Feuil2.Range("a" & c & ":a" & r)
For i = 1 To UBound(t): t(i, 1) = m(t(i, 1)): Next i
Feuil2.Range("c" & c).Resize(UBound(t)) = t
m.RemoveAll: Erase t
With Application: .ScreenUpdating = 1: .DisplayAlerts = 1: .EnableEvents = 1: .Calculation = 1: End With
MsgBox "Realisée en... " & Format(Timer - s, "0.00") & " secondes"
End Sub