Lister des combinaisons sur plusieurs colonnes

Sub col2a2()
Dim TabCol1(), TabCol2() As Variant
Dim TabloInter() As Variant
Dim tabloFinal() As Variant
Dim Dimension() As Variant

Sheets("Feuil3").UsedRange.ClearContents
With ActiveSheet
    NbCol = .Cells(1, .Columns.Count).End(xlToLeft).Column 'récupère le nombre de colonnes
    nbLignemax = .UsedRange.Rows.Count 'taille de la zone de data
    TabData = .Range("A1").Resize(nbLignemax, NbCol).Value 'on récupère tout le tablo de données

    ReDim Dimension(1 To NbCol) 'tablo 1D contenant les dimensions de chaque colonne
    nbligne = 1 'initialisation du nombre total de combinaisons

    For i = 1 To NbCol 'sur chaque colonne
        Dimension(i) = Cells(Rows.Count, i).End(xlUp).Row  'on compte le nombre d'éléments de la colonne
        nbligne = nbligne * Dimension(i) 'calcul du nombre final de combinaisons
    Next i
  
'on set la première colonne
    If Dimension(1) = 1 Then
        TabCol1 = Range("A1").Value
    Else
        TabCol1 = .Range("A1:A" & Dimension(1)).Value
    End If

    For i = 1 To NbCol - 1
        If Dimension(i + 1) = 1 Then  'Cas Particulier d'un SEUL élément ==> Table impossible...?..
            Element = Cells(1, i + 1)
            ReDim TabloInter(1 To (UBound(TabCol1)), 1)
            j = 1
            For A = 1 To UBound(TabCol1)
                TabloInter(j, 1) = TabCol1(A, 1) & "-" & Element
                j = j + 1
            Next A
        '************
        Else
            TabCol2 = .Range("A1").Offset(0, i).Resize(Dimension(i + 1)).Value 'on set la colonne 2
  
            ReDim TabloInter(1 To (UBound(TabCol1)) * (Dimension(i + 1)), 1)
            j = 1
            For A = 1 To UBound(TabCol1)
                For b = 1 To UBound(TabCol2)
                    TabloInter(j, 1) = TabCol1(A, 1) & "-" & TabCol2(b, 1)
                    j = j + 1
                Next b
            Next A
            'ReDim TabCol1(1 To UBound(TabloInter), 1)
            'TabCol1 = TabloInter
        End If
        ReDim TabCol1(1 To UBound(TabloInter), 1)
        TabCol1 = TabloInter
Next i
                      
End With

If UBound(TabloInter) > Rows.Count Then
    MsgBox "Trop de lignes, il faut Separer"
    Sheets("Feuil3").Range("A1").Resize(UBound(TabloInter) / 2, 2) = TabloInter
Else
    Sheets("Feuil3").Range("A1").Resize(UBound(TabloInter), 2) = TabloInter
End If

Sheets("Feuil3").Activate
Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1)), TrailingMinusNumbers:=True
End Sub