Microsoft 365 combinaisons Macros

Bonjour TTI,
Un essai en PJ.
Votre ex de résultat me semble faux, il manque P1617.
Dans la PJ l'ordre de rangement est le binaire 001,010,011,100 ....
L'ordre n'est pas le même, par contre toutes les combinaisons y sont.
Le résultat est en feuil2.

Merci bcp, ça marche.

Bonjour,
J'ai une autre demande, dans le cas ou je souhaite, afficher dans la colonne A par exemple :
PP15PP16 au lieu de PP1516 etc (c'est à dire au lieu de 16 ou 17) est ce posible.
Merci

Re,
Voilà.

Pour info, j'ai pu modifié le code en ajoutons le traitement sur le titre et de modifier la liste
de la Colonne A, :
PP
PP15
PP16
PP17
:

Sub Dispatche()
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
Nbits = DL - 1
IndexW = 1
With Sheets("Feuil2")
.Cells.ClearContents
For N = 0 To 2 ^ (DL - 1) - 1 ' DL-1 : Nombre d'éléments. 2 ^ (DL - 1) - 1 : Nombre de combinaisons
Mot = Right("0000" & Application.Dec2Bin(N), DL - 1) ' met la combinaison en binaire formaté au nombre de bit d'entrée
Titre = Cells(1, "A")
Ligne = IndexW
For B = 1 To Nbits ' Pour chaque bits
If Val(Mid(Mot, B, 1)) = 0 Then ' si 0 on met à droite
.Cells(IndexW + B, "C") = Right$(Cells(B + 1, "A"), Len(Cells(B + 1, "A")) - 2)
Else
.Cells(IndexW + B, "B") = Right$(Cells(B + 1, "A"), Len(Cells(B + 1, "A")) - 2) ' si 1 on met à gauche
Titre = Titre & Cells(B + 1, "A") ' on ajoute l'élément au titre
'Right$(MaChaineA, TA - 2)
End If
Next B
If Len(Titre) > 4 Then
.Cells(Ligne, "A") = Right$(Titre, Len(Titre) - 2) ' on range le titre
Else
.Cells(Ligne, "A") = Titre
End If
IndexW = IndexW + Nbits + 1
'Call Convert
Next N
.Activate
End With
End Sub

Une remarque SVP, quand je utilise cette liste, j'ai doublons au niveau de la valeur 11 :

Re,
N'étant pas spécifié, j'avais limité à 5 le nombre de variables. En PJ je l'ai augmenté à 20.

Merci bcp.