Sub test()
Dim a(), b%(), i&, u&, j&, k&, r&
a = Array(6, 7, 8, 9, 10, 11, 12, 13)
Sheets.Add
For i = 2 To 7
b = CTab(UBound(a) - LBound(a) + 1, i): u = UBound(b)
For j = 1 To UBound(b): For k = 1 To UBound(b, 2): b(j, k) = a(b(j, k) - 1): Next k, j
Range(Cells(r + 1, 1), Cells(r + u, i)) = b
r = r + u
Next i
End Sub
Function CTab(ByVal a%, ByVal b%) As Integer()
Dim n&, t%(), c&, i&, j&, d As Boolean
n = CNb(a, b): ReDim t(1 To n, 1 To b): c = a - b
For i = 1 To b: t(1, i) = i: Next i
For i = 2 To n
If b = 1 Then t(i, 1) = t(i - 1, 1) + 1 Else t(i, 1) = t(i - 1, 1) - (t(i - 1, 2) = c + 2)
For j = 2 To b - 1
If Not (t(i - 1, j + 1) = c + j + 1) Then t(i, j) = t(i - 1, j) Else d = t(i - 1, j) = c + j: t(i, j) = t(i + Not d, j + d) + 1
Next j
If t(i - 1, b) = a Then t(i, b) = t(i, b - 1) + 1 Else t(i, b) = t(i - 1, b) + 1
Next i
CTab = t
End Function
Function CNb(ByVal a%, ByVal b%) As Long
Dim c&
c = a - b
If b < c Then c = b
If c = 0 Then CNb = 1 Else CNb = CFact(a, c) / CFact(c)
End Function
Function CFact(ByVal Lg&, Optional NbIter) As Double
Dim i&, n&
If Not IsMissing(NbIter) Then n = NbIter Else n = Lg
CFact = 1
If Lg > 0 Then
For i = 0 To n - 1: CFact = CFact * (Lg - i): Next i
End If
End Function