Sub MyCombin()
    Dim a&(), i&, j&, m&, n&, p&, Sh As Worksheet, CurSh As Integer, Total&
    n = Val(InputBox("n =", , 10))
    m = Val(InputBox("m =", , 3))
    If n < m Or m < 1 Then Exit Sub

    Total = WorksheetFunction.Combin(n, m)
    If Total > 10 ^ 6 Then
        ReDim a&(1 To m), b&(1 To 10 ^ 6, 1 To m)
    Else
        ReDim a&(1 To m), b&(1 To Total, 1 To m)
    End If

    CurSh = 0
    For i = 1 To m: a(i) = i: Next i
    If m = n Then p = 1 Else p = m

    Do
        j = j + 1
        For i = 1 To m: b(j, i) = a(i): Next i
        If a(m) = n Then p = p - 1 Else p = m
        If p Then
            For i = m To p Step -1
                a(i) = a(p) + i - p + 1
            Next i
        End If
        If j = 10 ^ 6 Then
            With ThisWorkbook
                CurSh = CurSh + 1
                If .Worksheets.Count < CurSh Then
                    Set Sh = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
                Else
                    Set Sh = .Worksheets(CurSh)
                    Sh.Range("a1").CurrentRegion.ClearContents
                End If
                Sh.Range("a1").Resize(UBound(b), m) = b
                Total = Total - UBound(b)
                If Total > 10 ^ 6 Then
                    ReDim b&(1 To 10 ^ 6, 1 To m)
                Else
                    ReDim b&(1 To Total, 1 To m)
                End If
                j = 0
            End With
        End If

        DoEvents
    Loop While p
    If Total > 0 Then
        With ThisWorkbook
            CurSh = CurSh + 1
            If .Worksheets.Count < CurSh Then
                Set Sh = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
            Else
                Set Sh = .Worksheets(CurSh)
                Sh.Range("a1").CurrentRegion.ClearContents
            End If
            Sh.Range("a1").Resize(UBound(b), m) = b
        End With
    End If
End Sub