Sub Arrangement()
Dim i&, L As Byte, j&, Tb() As Byte, t$, k As Byte, ii As Byte, b As Boolean, Ts() As Byte, n&, Tl$()
Const St = "NRJBVW"
L = Len(St): ReDim Ts(1 To L, 0)
For i = 2 To L - 1 'To L pour inclure les permuts avec tous les éléments / For i=1 pour inclure les éléments seuls
ReDim Tb(1 To i)
For j = 10 ^ (i - 1) To 10 ^ i - 1
t = j
For k = 1 To i
Tb(k) = Right(Left(t, k), 1)
If Tb(k) > L Or Tb(k) = 0 Then b = False: Exit For
b = True
For ii = 1 To k - 1
If Tb(k) = Tb(ii) Then b = False: Exit For
Next ii
If Not b Then Exit For
Next k
If b Then
n = n + 1
ReDim Preserve Ts(1 To L, n)
For k = 1 To i: Ts(k, n) = Tb(k): Next k
End If
Next j
Next i
Sheets.Add
ReDim Tl(1 To L)
For i = 1 To L: Tl(i) = Right(Left(St, i), 1): Next i
For i = 1 To UBound(Ts, 2)
t = ""
For j = 1 To L
If Ts(j, i) > 0 Then t = t & Tl(Ts(j, i)) Else Exit For
Next j
Cells(i, 1) = t
Next i
End Sub