Split_list_in_many_columns

[Bruno_x]

From time to time I have to split a list in 2 or more columns. The following code could be useful to someone else.
There are only 5 parameters to adjust (see code)

Sub Split_list_in_many_columns()
Dim nColumns, nRows, nSections, nBlankColumns, nBlankRows, x, y As Integer

'*** adjust to your needs ***
'how many columns in the list
nColumns = 3
'how many rows on one page
nRows = 50
'how many sections
nSections = 3
'how many columns between the sections
nBlankColumns = 1
'how many rows between the pages
nBlankRows = 2
'****************************

'the list starts in cell A1
Lastrow = Range("A65536").End(xlUp).Row
iPages = Int((Lastrow / nRows / nSections) + 1)
Application.ScreenUpdating = False

'insert extra columns to prevent data loss
Range(Cells(1, nColumns + 1), Cells(1, nColumns + (nColumns + nBlankColumns) * _
    (nSections - 1))).EntireColumn.Insert

'main loop
For x = 1 To iPages
    For y = 1 To nSections - 1
        'cut and paste cells to next section
        Range(Cells((x * nRows) + ((x - 1) * nBlankRows) + 1, 1), _
            Cells((x + 1) * nRows + ((x - 1) * nBlankRows), nColumns)).Cut _
            Destination:=Cells((x * nRows) - (nRows - 1) + ((x - 1) * nBlankRows), (y * (nColumns + nBlankColumns)) + 1)

        'remove the empty rows
        Range(Cells((x * nRows) + ((x - 1) * nBlankRows) + 1, 1), _
            Cells((x + 1) * nRows + ((x - 1) * nBlankRows), nColumns)).Delete Shift:=xlUp
    Next

    'insert empty rows after each page
    Range(Cells((x * nRows) + ((x - 1) * nBlankRows) + 1, 1), _
        Cells((x * nRows) + (x * nBlankRows), 1)).EntireRow.Insert
    Application.StatusBar = iPages - x & " pages to go ..."
Next

Application.StatusBar = ""
Application.ScreenUpdating = True
Range("a1").Select
End Sub

Any comments or recommendations?