Option Explicit
Sub Correspondance_insérer()
Dim c As Range, cc As Range
For Each c In Range(Range("a2"), Range("a2").End(xlDown))
Set cc = Sheets("Correspondance").Range("a:a").Find(what:=Right(c, 3))
If Not cc Is Nothing Then c.Offset(, 1) = cc.Offset(, 1)
Next
End Sub