Sub Bouton2_QuandClic()
'nécessite l'activation de la référence : Microsoft scripting runtime
Dim data As New Dictionary
Dim plage As Range, c As Range
Dim x As Integer
With Sheets('feuil2')
Set plage = .Range('a1:a' & .Range('a65536').End(xlUp).Row)
End With
For Each c In plage
If data.Exists(CStr(c)) = False Then
data.Add Item:=Application.CountIf(plage, c), Key:=CStr(c)
x = x + 1
End If
Next c
Range(Cells(1, 2), Cells(x, 2)) = Application.Transpose(data.Items)
Range(Cells(1, 1), Cells(x, 1)) = Application.Transpose(data.Keys)
End Sub