Sub compter()
[F2:P10000].ClearContents
Application.ScreenUpdating = False
T = Range("B3:D" & [A1000].End(xlUp).Row)
For u = 1 To 10
Ligne = 2: Colonne = u + 5: Ecart = 0
For i = 1 To UBound(T)
Ecart = Ecart + 1
If T(i, 1) = u Or T(i, 2) = u Or T(i, 3) = u Then
If Ligne > 2 Then Cells(Ligne, Colonne) = Ecart
Ecart = 0
Ligne = Ligne + 1
End If
Next i
Next u
End Sub