Sub EtendreTest()
Dim plage As Range, d As Object, cel As Range, txt$
Application.ScreenUpdating = False
On Error Resume Next
Set plage = [E2:E65536].SpecialCells(xlCellTypeConstants, 2)
Set d = CreateObject("Scripting.Dictionary")
For Each cel In plage.Offset(, -4)
If Not d.Exists(cel.Value) Then
txt = cel
d.Add txt, txt
[A:A].Replace txt, 1, LookAt:=xlWhole
Set plage = [A:A].SpecialCells(xlCellTypeConstants, 1)
plage.Offset(, 4) = cel.Offset(, 4)
plage = txt
End If
Next
End Sub