Sub test()
Dim TTit(), TE(), TS(), LE&, LS&, C, IdFunc As SsGr, DCount As New Dictionary, Site As SsGr, F As Long, Wsh As Worksheet
TTit = Feuil22.[A2:K2].Value
TE = Feuil22.[A3:K3].Resize(Feuil22.[A1000000].End(xlUp).Row - 2).Value
ReDim TS(1 To UBound(TE, 1) * (UBound(TE, 2) - 2), 1 To 3)
For LE = 1 To UBound(TE, 1)
For C = 3 To UBound(TE, 2)
If TE(LE, C) <> "" Then
LS = LS + 1
TS(LS, 1) = TE(LE, 1)
TS(LS, 2) = TE(LE, 2)
TS(LS, 3) = TTit(1, C)
End If: Next C, LE
Feuil23.[A2:C1000000].ClearContents
Feuil23.[A2:C2].Resize(LS).Value = TS
For Each IdFunc In Gigogne(Feuil24.[A2], 1)
DCount(IdFunc.Id) = IdFunc.Count: Next IdFunc
For F = 4 To ThisWorkbook.Worksheets.Count
Set Wsh = ThisWorkbook.Worksheets(F)
Wsh.Name = Wsh.CodeName: Next F
F = 3
GigIdx.DernièreLigneÀIndexer = LS
For Each Site In Gigogne(TS, 3, 1)
ReDim TS(1 To Site.Count, 1 To 3)
LS = 0
For Each IdFunc In Site.Co
LS = LS + 1
TS(LS, 1) = IdFunc.Id
TS(LS, 2) = IdFunc.Co(1)(2)
TS(LS, 3) = DCount(IdFunc.Id)
Next IdFunc
If F >= ThisWorkbook.Worksheets.Count Then ThisWorkbook.Worksheets(F).Copy _
After:=ThisWorkbook.Worksheets(F)
F = F + 1: Set Wsh = ThisWorkbook.Worksheets(F)
Wsh.Name = Site.Id
Wsh.[A2:C1000000].ClearContents
Wsh.[A2:C2].Resize(LS).Value = TS
Next Site
F = F + 1
Application.DisplayAlerts = False
While F <= ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(F).Delete: Wend
Application.DisplayAlerts = True
End Sub