Sub test2()
Dim data
Dim plage As Range, c As Range
Set data = CreateObject("Scripting.Dictionary")
Set plage = Range("a1:a" & Range("a65536").End(xlUp).Row)
For Each c In plage
If data.Exists(CStr(c)) = False Then
data.Add Item:=Application.CountIf(plage, c), Key:=CStr(c)
End If
Next c
Range(Cells(1, 3), Cells(data.Count, 3)) = Application.Transpose(data.Items)
Range(Cells(1, 2), Cells(data.Count, 2)) = Application.Transpose(data.Keys)
End Sub