Перечисление перестановок с повторениями

Sub ыыфа()
Dim A(10, 10), B(720)
For i = 1 To 6
A(i, 1) = "М": A(i, 2) = "О": A(i, 3) = "Л": A(i, 4) = "О": A(i, 5) = "К": A(i, 6) = "О"
Next i
d = 1
For i = 1 To 6
For j = 1 To 6
For k = 1 To 6
For l = 1 To 6
For m = 1 To 6
For n = 1 To 6
If i = j Then GoTo 10
If i = k Then GoTo 10
If i = l Then GoTo 10
If i = m Then GoTo 10
If i = n Then GoTo 10
If j = k Then GoTo 10
If j = l Then GoTo 10
If j = m Then GoTo 10
If j = n Then GoTo 10
If k = l Then GoTo 10
If k = m Then GoTo 10
If k = n Then GoTo 10
If l = m Then GoTo 10
If l = n Then GoTo 10
If m = n Then GoTo 10
'Cells(d, 1) = A(i, j) + A(j, k) + A(k, l) + A(l, m) + A(m, n) + A(n, i)
B(d) = A(i, j) + A(j, k) + A(k, l) + A(l, m) + A(m, n) + A(n, i)
d = d + 1
10 '***
Next n, m, l, k, j, i
d = 1
For j = 1 To 720
For i = j To 719
If B(j) = B(i + 1) Then GoTo 20
GoTo 30
20 Cells(d, 2) = B(j)
d = d + 1
30 '***
Next i, j
End Sub

Dim r As Long, c As Long
 
Sub main()
  c = 2
  r = 0
  Pn "МОЛОКО"
End Sub
 
Public Sub Pn(S As String, Optional SS As String = "")
Dim i As Integer
  If Len(S) = 1 Then
    r = r + 1
    If r > Rows.Count Then c = c + 1: r = 1
    Cells(r, c) = SS & S
  Else
    For i = 1 To Len(S)
      Pn Left$(S, i - 1) & Mid$(S, i + 1), SS & Mid$(S, i, 1)
    Next
  End If
End Sub