Sub denombre()
tablo = Sheets("base").Range("G4:L" & Sheets("base").Range("G" & Rows.Count).End(xlUp).Row)
Set dico = CreateObject("Scripting.dictionary")
For n = LBound(tablo, 1) To UBound(tablo, 1)
x = tablo(n, 1)
If InStr(dico(x), tablo(n, UBound(tablo, 2))) = 0 Then dico(x) = dico(x) & tablo(n, UBound(tablo, 2)) & ";"
Next
a = dico.keys
b = dico.items
For n = LBound(a) To UBound(a)
Sheets("recap").Cells(6 + n, 1) = a(n)
Sheets("recap").Cells(6 + n, 3) = UBound(Split(b(n), ";"))
Next
End Sub