Macro Création tableau avec liste itérative imbriquée

Sub a()
Dim dl1&, x$, sh As Worksheet: Set sh = ActiveSheet
'/////////////////////////////////////////////////////////////////////////////////////
'les trois lignes ci dessous ne servent qu'à créer les données pour l'exemple
Cells.Clear
Range("A1:A5").Value = Application.Transpose(Array("A", "B", "C", "D", "E"))
MsgBox "Poursuivre le test ?"
'////////////////////////////////////////////////////////////////////////////////////
For dl1 = Cells(Rows.Count, "A").End(3).Row To 2 Step -1
If Cells(dl1, "A") <> Cells(dl1 - 1, "A") Then Rows(dl1).Resize(2).EntireRow.Insert
Next dl1

With Range(sh.Cells(1, 1), sh.Cells(Rows.Count, 1).End(3)(3))
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
    With .Offset(, 1)
        x = .Address
        With .Cells(1, 1).Resize(3)
        .Value = Application.Transpose([{"S","M","XL"}])
        .AutoFill Destination:=Range(x)
        End With
    End With
End With
End Sub

Sub essai()
  a = Array("s", "m", "xl")
  b = Array("a", "b", "c", "d", "e")
  c = Array("mk", "ml")
  d = Array("bv", "bc", "bn")
  Dim Tbl(0 To 200, 0 To 3)
  For m = LBound(d) To UBound(d)
   For k = LBound(c) To UBound(c)
    For j = LBound(b) To UBound(b)
     For i = LBound(a) To UBound(a)
       ind = m * (UBound(c) + 1) * (UBound(b) + 1) * (UBound(a) + 1) _
           + (k * (UBound(b) + 1) * (UBound(a) + 1)) _
             + (j * (UBound(a) + 1)) + i
       Tbl(ind, 0) = d(m)
       Tbl(ind, 1) = c(k)
       Tbl(ind, 2) = b(j)
       Tbl(ind, 3) = a(i)
     Next i
    Next j
   Next k
  Next m
  [J3:m200] = Tbl
End Sub

Sub ab()
Dim dl1&, x$, sh As Worksheet: Set sh = ActiveSheet
'/////////////////////////////////////////////////////////////////////////////////////
'les trois lignes ci dessous ne servent qu'à créer les données pour l'exemple
Cells.Clear
Range("A1:A5").Value = Application.Transpose(Array("A", "B", "C", "D", "E"))
MsgBox "Poursuivre le test ?"
'////////////////////////////////////////////////////////////////////////////////////
'On insére une ligne vide entre dès que la valeur change dans la colonne A
For dl1 = Cells(Rows.Count, "A").End(3).Row To 2 Step -1
If Cells(dl1, "A") <> Cells(dl1 - 1, "A") Then Rows(dl1).Resize(2).EntireRow.Insert
Next dl1

With Range(sh.Cells(1, 1), sh.Cells(Rows.Count, 1).End(3)(3))
' On insère une formule dans les cellules vides de la colonne
'formule qui recopie la valeur du dessus
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
'On transforme les formules en valeurs seuls
    .Value = .Value
'On se décale en colonne B
    With .Offset(, 1) ' dans la cellule B1
        x = .Address 'on mémorise l'adresse de la plage de cellules pour la recopie
        With .Cells(1, 1).Resize(3) 'en B1:B3 en copie S,M,XL
        .Value = Application.Transpose([{"S","M","XL"}])
'puis on recopie vers le bas ces trois valeurs
        .AutoFill Destination:=Range(x)
        End With
    End With
End With
End Sub

Sub essai()
  a = Application.Transpose([packagecode])
  b = Application.Transpose([pro])
  c = Application.Transpose([div])
  d = Application.Transpose([pl])
  Dim Tbl(0 To 500, 0 To 3)
  ind = 0
  For m = LBound(d) To UBound(d)
   For k = LBound(c) To UBound(c)
    For j = LBound(b) To UBound(b)
     For i = LBound(a) To UBound(a)
       Tbl(ind, 0) = d(m): Tbl(ind, 1) = c(k): Tbl(ind, 2) = b(j): Tbl(ind, 3) = a(i)
       ind = ind + 1
     Next i
    Next j
   Next k
  Next m
  Sheets("tableau").[d3:g500] = Tbl
End Sub

Sub essai()
  a = Application.Transpose([packagecode])
  b = Application.Transpose([Process])
  c = Application.Transpose([Division])
  d = Application.Transpose([Plant])
  e = Application.Transpose([DC])
  f = Application.Transpose([State])
  g = Application.Transpose([AN])
  Dim Tbl(0 To 300000, 0 To 6)
  ind = 0
  For o = LBound(g) To UBound(g)
   For n = LBound(f) To UBound(f)
    For m = LBound(e) To UBound(e)
     For l = LBound(d) To UBound(d)
      For k = LBound(c) To UBound(c)
       For j = LBound(b) To UBound(b)
        For i = LBound(a) To UBound(a)
         Tbl(ind, 0) = g(o): Tbl(ind, 1) = f(n): Tbl(ind, 2) = e(m): Tbl(ind, 3) = d(l): Tbl(ind, 4) = c(k): Tbl(ind, 5) = b(j): Tbl(ind, 6) = a(i)
         ind = ind + 1
        Next i
       Next j
      Next k
     Next l
    Next m
   Next n
  Next o
  Sheets("Tableau").[B3:H300000] = Tbl
End Sub