Sub TphSD()
Set f1 = Sheets("appels du mois")
Set f2 = Sheets("extraction sans doublons")
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In f1.[H2:S35]
If c.Text <> "" Then mondico(c.Text) = mondico(c.Text) + 1
Next c
f2.[a2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
f2.[b2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
End Sub