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