Sub Regrouper()
Dim TR(), LR&, Arg1 As SsGr, Arg2 As SsGr, Arg3 As SsGr, Arg4 As SsGr, _
TTit(), RngCbl As Range, TJoin() As String, J As Long, RngPoliceRg As Range
TTit = ActiveSheet.[A1:E1].Value
ReDim TR(1 To 100000, 1 To 3)
Set RngCbl = ActiveSheet.[G2].Resize(UBound(TR, 1), 3)
RngCbl.Font.Color = 0
For Each Arg2 In Gigogne(ActiveSheet.[A2:E2], -2, -4, -3, 1)
For Each Arg4 In Arg2.Co
For Each Arg3 In Arg4.Co
ReDim TJoin(1 To Arg3.Count): J = 0
For Each Arg1 In Arg3.Co: J = J + 1: TJoin(J) = Arg1.Id: Next Arg1
LR = LR + 1: TR(LR, 1) = TTit(1, 1): TR(LR, 2) = "'" & Join(TJoin, ".")
LR = LR + 1: TR(LR, 1) = TTit(1, 2): TR(LR, 2) = Arg2.Id: If Arg2.Id > 200 Then TR(LR, 3) = 1
LR = LR + 1: TR(LR, 1) = TTit(1, 3): TR(LR, 2) = Arg3.Id: If Arg3.Id > 25 Then TR(LR, 3) = 1
LR = LR + 1: TR(LR, 1) = TTit(1, 4): TR(LR, 2) = Arg4.Id: If Arg4.Id = 2150 Then TR(LR, 3) = 1
LR = LR + 1: TR(LR, 1) = TTit(1, 5): TR(LR, 2) = Arg4.Somme(5)
LR = LR + 1
Next Arg3, Arg4, Arg2
RngCbl.Value = TR
On Error Resume Next: Set RngCbl = RngCbl.Columns(3).SpecialCells(xlCellTypeConstants)
If Err Then Exit Sub
RngCbl.Offset(, -1).Font.Color = &HFF&
RngCbl.EntireColumn.Delete
End Sub