bonjour,
une solution faite sur mesure pour ton exemple.
Sub aargh()
Dim i&, j&
Range("O9").Resize(90, 3).Clear
For i = 17 To 8 Step -1
If Application.Sum(Cells(i, 5).Resize(, 9)) > 0 Then
Range("E7:M17").Sort key1:=Cells(i, "E"), order1:=xlDescending, Orientation:=2, Header:=xlNo
For j = 5 To 13
If Cells(i, j) > 0 Then
k = k + 1
Cells(k + 8, "O") = k
Cells(k + 8, "P") = Cells(7, j)
Cells(k + 8, "Q") = Cells(i, "D")
Else
Exit For
End If
Next j
End If
Next i
Range("E7:M17").Sort key1:=Cells(7, "E"), order1:=xlAscending, Orientation:=2, Header:=xlNo
End Sub