Private Sub Worksheet_Deactivate()
Dim PlgDon As Range, Titres1(), Titres2(), CodSiret As SsGr, NumSiret As SsGr, F As Long, NomFeui As String, FDest As Worksheet, _
TDt(), LDt As Long, TCd(), LCd As Long, TRc(), LRc As Long, TSp(), LSp 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, DicRécap As New Dictionary, CléRécap$
Me.Cells(1, 38).Value = "M_COTIS Corrigé"
Set PlgDon = Me.UsedRange
If PlgDon.Rows.Count < 2 Then Exit Sub
Application.ScreenUpdating = False
Titres1 = PlgDon.Rows(1).Value: Titres2 = PlgDon(1, 30).Resize(, 8).Value
Set PlgDon = PlgDon.Rows(2).Resize(PlgDon.Rows.Count - 1)
PlgDon.Columns(38).FormulaR1C1 = "=IF(RC35=0,RC37,ROUND(RC34*(RC35+RC36)/100,0))"
With ThisWorkbook.Worksheets: For F = FSiret1.Index To .Count: .Item(F).Name = .Item(F).CodeName: Next F: End With
F = FSiret1.Index - 1
TRc = Intersect(FRécTab.[A2:G1000000], FRécTab.UsedRange).Value
For LRc = 1 To UBound(TRc, 1): DicRécap(TRc(LRc, 1) & "|" & TRc(LRc, 2) & "|" & TRc(LRc, 3)) = TRc(LRc, 4): Next LRc
LRc = 0
ReDim TRc(1 To 1000, 1 To 8): LRc = 0
ReDim TSp(1 To 1000, 1 To 8): LSp = 0
For Each CodSiret In Gigogne(PlgDon.Rows(2).Resize(PlgDon.Rows.Count - 1), 1, 2, 31, 33, 35, 36, 30, 32)
For Each NumSiret In CodSiret.Co
NomFeui = CodSiret.Id & "-" & Right$(String$(5, Chr$(133)) & 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
LRc = LRc + 1: For C = 1 To 8: TRc(LRc, C) = Choose(C, NomFeui, "Brut SS", "SS Plaf", _
"Base CSG", "Net Imposable", "Cice", "Chômage", "Apprentis", "Montant déclaré"): Next C
With FRécap.Cells(LRc, 1).Resize(, 8): .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
With FRécap.Cells(LRc, 1).Resize(4): .Font.Bold = True: .Interior.Color = RGB(255, 240, 186): End With
LRc = LRc + 1: TRc(LRc, 1) = "Montant": TRc(LRc + 1, 1) = "Dads": TRc(LRc + 2, 1) = "Ecart"
ReDim TDt(1 To 5000, 1 To 37), TCd(1 To 3000, 1 To 8): LDt = 0: LCd = 0
LSp = LSp + 1 = TSp(LSp, 1) = NomFeui
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
TSp(LSp, 2) = TSp(LSp, 2) + Détail(8)
TCd(LCd, 5) = TCd(LCd, 5) + Détail(34)
TCd(LCd, 8) = TCd(LCd, 8) + Détail(38)
CléRécap = Détail(30) & "|" & Détail(31) & "|" & Détail(33)
If DicRécap.Exists(CléRécap) Then C = DicRécap(CléRécap): TRc(LRc, C) = TRc(LRc, C) + Détail(34)
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
TRc(LRc + 1, 1) = "Dads": TRc(LRc + 2, 1) = "Ecart"
LRc = LRc + 3
Next NumSiret, CodSiret
FRécap.[A1:H1001].Value = TRc
For LRc = 4 To LRc Step 5: FRécap.Cells(LRc, 2).Resize(, 7).FormulaR1C1 = "=R[-2]C-R[-1]C": Next LRc
With ThisWorkbook.Worksheets
While .Count > F: Application.DisplayAlerts = False: .Item(.Count).Delete
Application.DisplayAlerts = True: Wend: End With
End Sub