Sub test()
Dim Dico As Object, C As Range, I As Long
Set Dico = CreateObject("Scripting.Dictionary")
For Each C In Range("A2", Cells(Rows.Count, 2).End(xlUp))
If Not Dico.exists(C.Value) Then
Dico.Add C.Value, C.Value
End If
Next C
For Each Item In Dico.keys
I = I + 1
[D1].Offset(I) = Item
Next Item
End Sub