Sub nombre()
Dim Cel As Range
Dim Nbr As Object
Set Nbr = CreateObject("Scripting.Dictionary")
For Each Cel In Range("E7").CurrentRegion
Nbr.Item(Cel.Value) = Nbr.Item(Cel.Value) + 1
Next Cel
Columns("A:B").Clear
Range("A1").Value = "Nombre": Range("B1").Value = "Nbr Répétition"
Range("A2").Resize(Nbr.Count) = Application.Transpose(Nbr.Keys)
Range("B2").Resize(Nbr.Count) = Application.Transpose(Nbr.Items)
Range("A1:B" & Nbr.Count + 1).Sort Key1:=Range("B2"), Order1:=xlDescending, Key2:=Range( _
"A2"), Order2:=xlAscending, Header:=xlYes
End Sub