Option Explicit
Sub test()
Call AffComb(49, 5)
End Sub
Sub AffComb(a&, b&)
Dim i#, NbCmb#, Rg As Range, Tb(), j%, NbWrt#, NbRw&, m%, c%, Tc&(), s&
If b > a Or b < 1 Or b > Columns.Count Then Exit Sub
Application.ScreenUpdating = False: m = Application.Calculation: Application.Calculation = xlCalculationManual
NbCmb = WorksheetFunction.Combin(a, b): NbWrt = NbCmb: ReDim Tc(1 To b)
Do
Sheets.Add: s = s + 1
Do
NbRw = Round(IIf(NbWrt > Rows.Count, Rows.Count, NbWrt)): ReDim Tb(1 To NbRw, 1 To b)
If c = 0 And s = 1 Then
For i = 1 To b
Tb(1, i) = i
Next i
Else
For i = 1 To b
Select Case i
Case 1
Tb(1, i) = IIf(Tc(i + 1) = a - b + 2, Tc(i) + 1, Tc(i))
Case b
Tb(1, i) = IIf(Tc(i) = a, Tc(i - 1) + 1, Tc(i) + 1)
Case Else
Tb(1, i) = IIf(Tc(i + 1) = a - b + i + 1, IIf(Tc(i) = a - b + i, Tc(i - 1) + 1, Tc(i) + 1), Tc(i))
End Select
Next i
End If
For i = 2 To NbRw
For j = 1 To b
Select Case j
Case 1
Tb(i, j) = IIf(Tb(i - 1, j + 1) = a - b + 2, Tb(i - 1, j) + 1, Tb(i - 1, j))
Case b
Tb(i, j) = IIf(Tb(i - 1, j) = a, Tb(i, j - 1) + 1, Tb(i - 1, j) + 1)
Case Else
Tb(i, j) = IIf(Tb(i - 1, j + 1) = a - b + j + 1, IIf(Tb(i - 1, j) = a - b + j, Tb(i, j - 1) + 1, Tb(i - 1, j) + 1), Tb(i - 1, j))
End Select
Next j, i
Set Rg = Range(Cells(1, c * (b + 1) + 1), Cells(NbRw, c * (b + 1) + b)): Rg = Tb
NbWrt = Round(NbWrt - NbRw): If NbWrt = 0 Then Exit Do
For i = 1 To b
Tc(i) = Tb(NbRw, i)
Next i
c = c + 1
Loop Until c * (b + 1) + b > Columns.Count
c = 0
Loop Until NbWrt = 0
Cells.EntireColumn.AutoFit
Application.ScreenUpdating = True: Application.Calculation = m
End Sub