Option Explicit
Private Sub Worksheet_Deactivate()
Dim PlgDon As Range, CodSiret As SsGr, FDest As Worksheet, TDt(), LDt As Long, _
TRs(), LRs As Long, CodCot As SsGr, Qualif As SsGr, TxCoti As SsGr, _
TxAtT23003 As SsGr, LibCot As SsGr, Commune As SsGr, C As Long, Détail As Variant
Set PlgDon = Me.UsedRange
Application.ScreenUpdating = False
If PlgDon.Rows.Count < 2 Then Exit Sub
For Each FDest In ThisWorkbook.Worksheets
If FDest.Index > 1 Then FDest.Cells.Value = Empty
Next FDest
For Each CodSiret In Gigogne(PlgDon.Rows(2).Resize(PlgDon.Rows.Count - 1), 1, 31, 33, 35, 36, 30, 32)
On Error Resume Next: Set FDest = ThisWorkbook.Worksheets(CodSiret.Id)
If Err Then With ThisWorkbook.Worksheets: .Item(.Count).Copy After:=.Item(.Count): _
Set FDest = .Item(.Count): FDest.Name = CodSiret.Id: End With
On Error GoTo 0
ReDim TDt(1 To 5000, 1 To 37), TRs(1 To 3000, 1 To 8): LDt = 0: LRs = 0
For Each CodCot In CodSiret.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
LRs = LRs + 1: TRs(LRs, 1) = LibCot.Id: TRs(LRs, 2) = CodCot.Id: TRs(LRs, 3) = Commune.Id: TRs(LRs, 4) = Qualif.Id
TRs(LRs, 6) = TxCoti.Id: TRs(LRs, 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
TRs(LRs, 5) = TRs(LRs, 5) + Détail(34)
TRs(LRs, 8) = TRs(LRs, 8) + Détail(37): Next Détail
Next Commune, LibCot, TxAtT23003, TxCoti, Qualif, CodCot
FDest.[AN1].Value = "CONDENSÉ"
FDest.[A1:AK1].Value = PlgDon.Rows(1).Value
FDest.[A2:AK5001].Value = TDt
FDest.[AN3:AU3].Value = PlgDon(1, 30).Resize(, 8).Value
FDest.[AN4:AU3003].Value = TRs
FDest.Cells(LRs + 5, "AU").FormulaR1C1 = "=SUBTOTAL(9,R4C:R[-2]C)"
FDest.Columns.AutoFit
FDest.[A:AK].Columns.Hidden = True
Next CodSiret
End Sub
