Option Explicit
Private Sub Worksheet_Activate()
Dim Données As Collection, Soc As SsGr, TTrv(), LMax As Long, TotCA As Currency, Détail, L As Long, C As Long, _
PCA As SsGr, NGrp As Long, IDP As SsGr, TRés(), Grp As SsGr, TJoin() As String, N As Long, Nom As SsGr, Nsoc As SsGr
Set Données = GigIdx.Gigogne(Feuil2.[A2:F2], -6, 4)
For Each PCA In Données: LMax = LMax + PCA.Nombre: Next PCA
ReDim TTrv(1 To LMax, 1 To 8)
For Each PCA In Données
For Each Soc In PCA.Co
NGrp = NGrp + 1
For Each Détail In Soc.Co
L = L + 1: For C = 1 To 6: TTrv(L, C) = Détail(C): Next C
TTrv(L, 8) = NGrp: Next Détail, Soc, PCA
L = 0
For Each IDP In GigIdx.Gigogne(TTrv, 1, Null, 4)
NGrp = IDP.Co(1)(8)
For Each Détail In IDP.Co
L = L + 1: For C = 1 To 6: TTrv(L, C) = Détail(C): Next C
TTrv(L, 8) = NGrp: Next Détail, IDP
L = 0
For Each Soc In GigIdx.Gigogne(TTrv, 4, Null, 1)
NGrp = Soc.Co(1)(8)
For Each Détail In Soc.Co
L = L + 1: For C = 1 To 6: TTrv(L, C) = Détail(C): Next C
TTrv(L, 8) = NGrp: Next Détail, Soc
L = 0
Set Données = GigIdx.Gigogne(TTrv, 8, Null, -3, 1)
ReDim TRés(1 To Données.Count, 1 To 6)
For Each Grp In Données
L = L + 1
TRés(L, 1) = Grp.Co(1)(1)
TRés(L, 3) = Grp.Co(1)(3)
Next Grp
L = 0
For Each Grp In GigIdx.Gigogne(TTrv, 8, 2)
L = L + 1: ReDim TJoin(1 To Grp.Count): N = 0
For Each Nom In Grp.Co: N = N + 1: TJoin(N) = Nom.Id: Next Nom
TRés(L, 2) = Join(TJoin, vbLf)
TRés(L, 6) = Grp.Count: Next Grp
L = 0
For Each Grp In GigIdx.Gigogne(TTrv, 8, Null, -6)
L = L + 1
TRés(L, 4) = Grp.Co(1)(4): Next Grp
L = 0
For Each Grp In GigIdx.Gigogne(TTrv, 8, 6)
L = L + 1: TotCA = 0
For Each Soc In Grp.Co: TotCA = TotCA + Soc.Co(1)(6): Next Soc
TRés(L, 6) = TotCA: Next Grp
Me.Rows(2).Resize(50000).ClearContents
With Me.[A2].Resize(UBound(TRés, 1), UBound(TRés, 2))
.Columns(1).NumberFormat = "@"
.Columns(4).NumberFormat = "0"
.Value = TRés: End With
End Sub