Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range("a2", [a65000].End(xlUp))
mondico.Item(c.Value) = mondico.Item(c.Value) + 1
Next c
Set mondico2 = CreateObject("Scripting.Dictionary")
For Each c In mondico.keys
If mondico(c) = 1 Then mondico2.Add c, 1
Next c
If mondico2.Count>0 Then [c2].Resize(mondico2.Count, 1) = Application.Transpose(mondico2.keys)