Sub sup()
a = Range("A2:A" & [A65000].End(xlUp).Row)
Set MonDico1 = CreateObject("Scripting.Dictionary")
For Each c In a
If Not MonDico1.exists(c) Then MonDico1.Add c, c
Next c
b = Range("b2:b" & [b65000].End(xlUp).Row)
Set MonDico2 = CreateObject("Scripting.Dictionary")
For Each c In b
If Not MonDico1.exists(c) Then If Not MonDico2.exists(c) Then MonDico2.Add c, c
Next c
[B2:B1000].ClearContents
[b2].Resize(MonDico2.Count, 1) = Application.Transpose(MonDico2.items)
End Sub