Option Explicit
Sub K20_4()
Dim w(1 To 2) As Worksheet, i&, Nbcb&, Rw&, Tb%(1 To 20), j&, k%
Application.ScreenUpdating = False
Nbcb = WorksheetFunction.Combin(20, 4)
Set w(1) = ActiveSheet
Sheets.Add
Set w(2) = ActiveSheet
For i = 1 To 4
w(2).Cells(1, i) = i
Next i
w(2).Cells(2, 1).FormulaR1C1 = "=IF(R[-1]C[1]=18,R[-1]C+1,R[-1]C)"
w(2).Cells(2, 2).FormulaR1C1 = "=IF(R[-1]C[1]=19,IF(R[-1]C=18,RC[-1]+1,R[-1]C+1),R[-1]C)"
w(2).Cells(2, 3).FormulaR1C1 = "=IF(R[-1]C[1]=20,IF(R[-1]C=19,RC[-1]+1,R[-1]C+1),R[-1]C)"
w(2).Cells(2, 4).FormulaR1C1 = "=IF(R[-1]C=20,RC[-1]+1,R[-1]C+1)"
w(2).Range(w(2).Cells(2, 1), w(2).Cells(2, 4)).AutoFill Destination:=w(2).Range(w(2).Cells(2, 1), w(2).Cells(Nbcb, 4))
Rw = w(1).Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Rw
For j = 1 To 20
Tb(j) = w(1).Cells(i, j)
Next j
For j = 1 To Nbcb
For k = 1 To 4
w(1).Cells(i, 20 + j) = w(1).Cells(i, 20 + j) & Tb(w(2).Cells(j, k))
Next k
Next j
Next i
Application.DisplayAlerts = False
w(2).Delete
Application.DisplayAlerts = True
w(1).Columns.AutoFit
Application.ScreenUpdating = True
End Sub