For Each NumSiret In CodSiret.Co
NomFeui = CodSiret.Id & "-" & Right$(String$(5, "…") & CStr(NumSiret.Id), 5)
With ThisWorkbook.Worksheets: If F = .Count Then .Item(F).Copy After:=.Item(F)
F = F + 1: Set FDest = .Item(F): FDest.Name = NomFeui: End With
ReDim TDt(1 To 5000, 1 To 37), TCd(1 To 3000, 1 To 8): LDt = 0: LCd = 0
For Each CodCot In NumSiret.Co: For Each Qualif In CodCot.Co: For Each TxCoti In Qualif.Co: For _
Each TxAtT23003 In TxCoti.Co: For Each LibCot In TxAtT23003.Co: For Each Commune In LibCot.Co
LCd = LCd + 1
TCd(LCd, 1) = LibCot.Id: TCd(LCd, 2) = CodCot.Id: TCd(LCd, 3) = Commune.Id
TCd(LCd, 4) = Qualif.Id: TCd(LCd, 6) = TxCoti.Id: TCd(LCd, 7) = TxAtT23003.Id
For Each Détail In Commune.Co
LDt = LDt + 1
For C = 1 To 37: TDt(LDt, C) = Détail(C): Next C
TCd(LCd, 5) = TCd(LCd, 5) + Détail(34)
TCd(LCd, 8) = TCd(LCd, 8) + Détail(38) ' Détail(37)
Next Détail, Commune, LibCot, TxAtT23003, TxCoti, Qualif, CodCot
FDest.[A1:AL1].Value = Titres1
FDest.[AN1].Value = "TABLEAU RECAPITULATIF"
FDest.[AO1].Value = NomFeui
FDest.[A2:AL5001].Value = TDt
FDest.[AN3:AU3].Value = Titres2
FDest.[AN4:AU3003].Value = TCd
FDest.Cells(LCd + 5, "AU").FormulaR1C1 = "=SUBTOTAL(9,R4C:R[-2]C)"
FDest.Columns.AutoFit
FDest.[A:AM].Columns.Hidden = True
Next NumSiret, CodSiret
FRécap.[A2:Z1001].Value = TRc