Permutations avec répétitions

[B][COLOR="DarkSlateGray"]Sub toto(base)
Dim i&, j%, n%, k%, d%, p%, ol&, oc&, oCel As Range, m%, tmp$
   n = base [COLOR="SeaGreen"]'Base de calcul de 0 à 6[/COLOR]
   d = 1 [COLOR="SeaGreen"]'Décalage des groupes de résultats[/COLOR]
   p = 2 [COLOR="SeaGreen"]'Décalage des colonnes de résultats[/COLOR]
   ol = 7 [COLOR="SeaGreen"]'Première ligne du tableau de résultats[/COLOR]
   oc = 4 [COLOR="SeaGreen"]'Première colonne du tableau de résultats[/COLOR]
   Range(Cells(ol, oc), Cells(ol, oc).SpecialCells(xlCellTypeLastCell)).ClearContents
   For k = 1 To n
      j = 0
      For i = 1 To n ^ (n - k + 1) - (k <> n) * (d * n ^ (n - k - 1)) Step n ^ (n - k) - (k <> n) * (d * n ^ (n - k - 1))
         j = j + 1
         Cells(i, p * (k - 1) + 1).Offset(ol - 1, oc - 1).Value = j
      Next i
      With Range(Cells(1, p * (k - 1) + 1), Cells(n ^ (n - k + 1), p * (k - 1) + 1)).Offset(ol - 1, oc - 1)
         For i = 0 To n ^ (k - 1) - 1
            .Offset(i * n ^ (n - k) * (n + d), 0).Value = .Value
            If k = n Then
               For Each oCel In .Offset(i * n ^ (n - k) * (n + d), 0).Cells
                  tmp = ""
                  For m = n - 1 To 0 Step -1
                     With oCel.Offset(0, -p * m)
                        If CStr(.Value) = "" Then
                           tmp = tmp & CStr(.End(xlUp).Value)
                        Else
                           tmp = tmp & CStr(.Value)
                        End If
                     End With
                  Next m
                  oCel.Offset(0, p).Value = tmp
               Next oCel
            End If
         Next i
      End With
   Next k
End Sub[/COLOR][/B]

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 2
End Sub[/B][/COLOR]

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 3
End Sub[/B][/COLOR]

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 4
End Sub[/B][/COLOR]

[COLOR="DarkSlateGray"][B]Sub tata()
   Me.Activate
   toto 5
End Sub[/B][/COLOR]