Option Explicit
Sub ListeSansDoublons()
Dim C As Range, MonDico As Object
Set MonDico = CreateObject("Scripting.Dictionary")
For Each C In Feuil1.Range("A5", [A65000].End(xlUp))
MonDico(C.Value) = MonDico(C.Value) + 1
Next C
Feuil2.[A5].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.keys)
Feuil2.[B5].Resize(MonDico.Count, 1) = Application.Transpose(MonDico.items)
End Sub