Set a Single Column of Data to Print on X pages (Excel Macro)

Category:

Office/VBA

Type:

Modules

Difficulty:

Intermediate

Author:

Dave Hawley

Version Compatibility: Visual Basic 6

More information:

This macro will take a single column of data delimited by page breaks and move the data in the even-numbered pages to the next column, cutting down the number of pages in the worksheet.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Sub RowsToColumns()
Dim rCol As Range
Dim rCell1 As Range, rCell2 As Range
Dim i As Integer, iPBcount As Integer
Dim Sht As Worksheet

Application.StatusBar = "Converting, please wait....!"
Application.ScreenUpdating = False

'Set range variable to Selection
Set Sht = ActiveSheet
Set rCol = Sht.UsedRange.Columns(1)
'Insert page breaks
     Sht.PageSetup.PrintArea = ""
     Sht.PageSetup.Zoom = 100
     ActiveWindow.View = xlPageBreakPreview

'Count only horizontal page breaks and pass to an Integer
iPBcount = Sht.HPageBreaks.Count

On Error Resume Next
 'Loop as many times as there horizontal page breaks.
    For i = 1 To iPBcount
        'Set variable 1 to  page break X
        Set rCell1 = Sht.HPageBreaks(i).Location
        'Set variable 2 to X page break
        Set rCell2 = Sht.HPageBreaks(i + 1).Location.Offset(-1, 0)
            If rCell2 Is Nothing Then 'Last page break
                Range(rCell1, rCol.Cells(65536, 1).End(xlUp)).Cut _
				 Destination:=Sht.Cells(1, i + 1)
            Else
                Range(rCell1, rCell2).Cut Destination:=Sht.Cells(1, i + 1)
            End If
        Set rCell1 = Nothing
        Set rCell2 = Nothing
    Next i
  On Error GoTo 0
  
  ActiveWindow.View = xlNormalView
  Application.ScreenUpdating = True
  Sht.DisplayPageBreaks = False
  Application.Goto rCol.Cells(1, 1), True
  Set rCol = Nothing
  Application.StatusBar = ""
End Sub