[kapetang]

Δημήτρη τώρα κατάλαβα τι θέλεις.

Δοκίμασε τον κώδικα:

Option Explicit
Dim x() As Variant, R As Long, mm As Long
Sub Combinations()
    Const startCel As String = "A1" 'Το κελί στο οποίο θα γίνει η 1η καταχώρηση
    Dim n As Integer, m As Integer, numcomb, rng As Range, numC As Long
    
    numcomb = 0
    n = InputBox("Number of items?", "Combinations")
    m = InputBox("Taken how many at a time?", "Combinations")
    mm = m
    Application.ScreenUpdating = False
    numC = Application.WorksheetFunction.Combin(n, m)
    Set rng = Range(startCel)
    ReDim x(1 To numC, 1 To m) As Variant
    R = 0
    Comb2 n, m, 1, ""
    rng.Resize(UBound(x, 1) + 5, mm + 2).ClearContents
    rng.Resize(UBound(x, 1), mm).Value = x
End Sub

'Generate combinations of integers k..n taken m at a time, recursively
Private Function Comb2(ByVal n As Integer, ByVal m As Integer, _
                       ByVal k As Integer, ByVal s As String)
    Dim j As Long
    If m > n - k + 1 Then Exit Function
    If m = 0 Then
        R = R + 1
        For j = 1 To mm
            x(R, j) = Split(s, " ")(j - 1)
        Next
        Exit Function
    End If
    Comb2 n, m - 1, k + 1, s & k & " "
    Comb2 n, m, k + 1, s
End Function