Sub redecouper()
Dim i&, i2&, j&, j2&, n&, x, ligne, tablo, res()
Sheets("Fin").Range("A2:G" & Rows.Count).ClearContents
Sheets("Depart").Select
i2 = Range("A" & Rows.Count).End(xlUp).Row
j2 = Cells(1, Columns.Count).End(xlToLeft).Column
ReDim res(1 To i2 * (j2 / 3), 1 To 7)
n = 0
For i = 2 To i2
tablo = Range(Cells(i, 1), Cells(i, j2))
ligne = 0
For j = 4 To j2 Step 3
ligne = ligne + 1
x = Abs(0 + tablo(1, j)) + Abs(0 + tablo(1, j + 1)) + Abs(0 + tablo(1, j + 2))
If x > 0 Then
n = n + 1
res(n, 1) = tablo(1, 1): res(n, 2) = tablo(1, 2): res(n, 3) = tablo(1, 3)
res(n, 4) = ligne
res(n, 5) = tablo(1, j): res(n, 6) = tablo(1, j + 1): res(n, 7) = tablo(1, j + 2)
End If
Next j
Next i
Application.Goto Sheets("Fin").Range("a1"), True
Range("A2").Resize(i2 * (j2 / 3), 7) = res
MsgBox "C'est fini !"
End Sub