Sub Prenom()
Dim cel As Range, c As New Collection, i As Long
On Error Resume Next
For Each cel In [Plage]
If cel <> "" Then
c.Add cel, CStr(cel)
End If
Next
[F2:G65536].ClearContents 'à translater dans des colonnes libres
For i = 1 To c.Count
Range("F" & i + 1) = c(i)
Range("G" & i + 1) = Application.CountIf([Plage], c(i))
Next
End Sub