Split_list_in_many_columns

Bruno

Active Member
Joined
Feb 17, 2002
Messages
491
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)

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?
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Forum statistics

Threads
1,141,587
Messages
5,707,258
Members
421,498
Latest member
matinebi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top