Sub es()
Dim i As Long, t(), m As Object
With Sheets("Feuil1")
Set m = CreateObject("Scripting.Dictionary")
t = .Range("e2:e" & .Cells(Rows.Count, 5).End(xlUp).Row).Value
For i = LBound(t) To UBound(t)
m(t(i, 1)) = m(t(i, 1)) + 1
Next
End With
With Sheets("Feuil2")
.Range("a2:b2000").ClearContents
.[a2].Resize(m.Count) = Application.Transpose(m.keys)
.[b2].Resize(m.Count) = Application.Transpose(m.items)
.[a2:b2000].Sort Key1:=.[b2], Order1:=xlDescending, Header:=xlGuess
End With
End Sub