Sub Regrouper()
Dim lig&, lig1&, col%
Application.ScreenUpdating = False
For lig = [A65536].End(xlUp).Row To 2 Step -1
lig1 = lig + 1
col = 6
While Cells(lig, col) <> ""
Rows(lig1).Insert
Cells(lig1, 4).Resize(, 2) = Cells(lig, col).Resize(, 2).Value
Cells(lig1, 1).Resize(, 3) = Cells(lig, 1).Resize(, 3).Value
lig1 = lig1 + 1
col = col + 2
Wend
Next
[F:IV].Delete
End Sub