Sub jb()
Dim m As Object, n As Object, c
Set m = CreateObject("Scripting.Dictionary")
For Each c In Feuil1.Range("a2", [a65000].End(3))
m(c.Value) = m(c.Value) + 1
Next c
Set n = CreateObject("Scripting.Dictionary")
For Each c In m.keys
If m(c) = 1 Then n(c) = ""
Next c
If n.Count > 0 Then Feuil2.[a2].Resize(n.Count, 1) = Application.Transpose(n.keys)
End Sub