Sub toto()
Dim i%, j%, k&, l%, Cat1&(), Dat(), x(), tf As Boolean
wksTableau.Cells(1, 1).Select
Dat = wksTableau.Cells(2, 2).Resize(26, 25).Value
wksListe.Cells.Clear
For j = 2 To UBound(Dat, 2)
ReDim Cat1(0 To UBound(Dat, 1) - 1)
For i = 2 To UBound(Dat, 1)
If Not IsEmpty(Dat(i, j)) And IsNumeric(Dat(i, j)) And 0 <> Dat(i, j) Then
Cat1(0) = Dat(i, j) + Cat1(0)
Cat1(i - 1) = Dat(i, j)
End If
Next
tf = True
If Cat1(0) Then
For l = 1 To UBound(Cat1, 1)
If Not IsEmpty(Cat1(l)) And 0 <> Cat1(l) Then
k = k + 1
x = Array(IIf(tf, "Dans la catégorie", ""), IIf(tf, Dat(1, j), Empty), _
IIf(tf, "il y aura", Empty), IIf(tf, Cat1(0), Empty), _
IIf(tf, IIf(Cat1(0) > 1, "joueurs affiliés", "joueur affilié") & " dont", Empty), Cat1(l), _
IIf(Cat1(l) > 1, "proviennent", "provient") & " de la catégorie", Dat(l + 1, 1))
wksListe.Cells(k, 1).Resize(, UBound(x) + 1).Value = x
tf = False
End If
Next
End If
k = k - Not tf
Next
wksListe.Columns("A:H").EntireColumn.AutoFit
wksListe.Activate
End Sub