Sub essai2()
Dim b()
t = Timer
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
a = [H2:I2].Resize([h65000].End(xlUp).Row)
For i = LBound(a) To UBound(a)
d(a(i, 1)) = a(i, 2)
Next i
'----
If Selection.Count > 1 Then
b = Selection
Else
ReDim b(1 To 1, 1 To 1)
b(1, 1) = ActiveCell
End If
For i = LBound(b) To UBound(b)
For j = LBound(b, 2) To UBound(b, 2)
If d.exists(b(i, j)) Then Selection.Cells(i, j) = d(b(i, j))
Next j
Next
MsgBox Timer() - t
End Sub