XL 2016 Listes déroulantes en cascade

Option Explicit
Private Sub CBnReconst_Click()
   Dim TDon(), TBase(), LD&, CÉp%, CFi%, LB&, LOt As ListObject
   TDon = Intersect(WshFou.[A3:AN1000000], WshFou.UsedRange).Value
   ReDim TBase(1 To UBound(TDon, 1) * 50, 1 To 6)
   For LD = 2 To UBound(TDon)
      For CÉp = 3 To 20: For CFi = 21 To 40
         If Not (IsEmpty(TDon(LD, CÉp)) Or IsEmpty(TDon(LD, CFi))) Then
         LB = LB + 1
         TBase(LB, 1) = TDon(LD, 1)
         TBase(LB, 2) = TDon(LD, 2)
         TBase(LB, 3) = TDon(1, CÉp)
         TBase(LB, 4) = TDon(1, CFi)
         TBase(LB, 5) = CCur(TDon(LD, CÉp))
         TBase(LB, 6) = CCur(TDon(LD, CFi))
         End If: Next CFi, CÉp, LD
   Set LOt = Me.ListObjects(1)
   TableauRetaillé(LOt, LMax:=LB) = TBase
   LOt.Range.Columns.AutoFit
   LOt.Sort.Apply
   End Sub

Property Let TableauRetaillé(ByVal LOt As ListObject, Optional ByVal LMax As Long, TVals())
   Dim Trop As Long, CMax As Long, TFml(), F As Long
   If LMax = 0 Then LMax = UBound(TVals, 1)
   Trop = LOt.ListRows.Count - LMax
   If Trop > 0 Then
      LOt.ListRows(LMax + 1).Range.Resize(Trop).Delete xlShiftUp
   ElseIf Trop < 0 And LMax + Trop > 1 Then
      LOt.ListRows(LMax + Trop).Range.Resize(-Trop).Insert xlShiftDown, xlFormatFromLeftOrAbove
      End If
   If LMax = 0 Then Exit Property
   ReDim TFml(1 To LOt.ListColumns.Count)
   For F = 1 To UBound(TFml)
      With LOt.HeaderRowRange(2, F)
         If .HasFormula Then TFml(F) = .Formula2R1C1 Else TFml(F) = Null
         End With: Next F
   LOt.HeaderRowRange.Offset(1).Resize(LMax).Value = TVals
   For F = 1 To UBound(TFml)
      If Not IsNull(TFml(F)) Then LOt.ListColumns(F).DataBodyRange.Formula2R1C1 = TFml(F)
      Next F
   End Property