Option Explicit
Sub Regroupement()
Dim TSyn(), LSyn&, NomFic As String, Wbk As Workbook, CodeCli As String, TCli(), LCli&, CMax&, C&, LOt As ListObject
ChDrive ThisWorkbook.Path: ChDir ThisWorkbook.Path
ReDim TSyn(1 To 1500, 1 To 10)
NomFic = Dir("*.xlsm")
Do While NomFic <> ""
Set Wbk = Workbooks.Open(NomFic)
TCli = Wbk.Worksheets(1).ListObjects(1).DataBodyRange.Value
CMax = UBound(TCli, 2): If CMax + 1 > UBound(TSyn, 2) Then ReDim Preserve TSyn(1 To 1500, 1 To CMax + 1)
For LCli = 1 To UBound(TCli, 1)
LSyn = LSyn + 1: TSyn(LSyn, 1) = CodeCli
For C = 1 To CMax: TSyn(LSyn, C + 1) = TCli(LCli, C): Next C, LCli
Wbk.Close SaveChanges:=False
Loop
Set LOt = ThisWorkbook.Worksheets(1).ListObjects(1)
If LOt.ListRows.Count > LSyn Then LOt.ListRows(LSyn + 1).Range.Resize(LOt.ListRows.Count - LSyn).Delete xlShiftUp
LOt.HeaderRowRange.Offset(1).Resize(LSyn, UBound(TSyn, 2)).Value = TSyn
End Sub
Sub Eclatement()
Dim LOt As ListObject, CMax&, Client As SsGr, TCli(), LCli&, Détail, C&, Wbk As Workbook
ChDrive ThisWorkbook.Path: ChDir ThisWorkbook.Path
Set LOt = ThisWorkbook.Worksheets(1).ListObjects(1)
CMax = LOt.ListColumns.Count - 1
For Each Client In Gigogne(LOt, 1, Null, 2, 3)
ReDim TCli(1 To Client.Count, 1 To CMax): LCli = 0
For Each Détail In Client.co
LCli = LCli + 1: For C = 1 To CMax: TCli(LCli, C) = Détail(C + 1): Next C, Détail
Wbk = Workbooks.Open(Client.ID & ".xlsm")
Set LOt = Wbk.Worksheets(1).ListObjects(1)
If LOt.ListRows.Count > LCli Then LOt.ListRows(LCli + 1).Range.Resize(LOt.ListRows.Count - LCli).Delete xlShiftUp
LOt.HeaderRowRange.Offset(1).Resize(LCli, CMax).Value = TCli
Wbk.Close SaveChanges:=True: Next Client
End Sub