Results 1 to 2 of 2
  1. #1
    Star Lounger
    Join Date
    Apr 2003
    Morgantown, Pennsylvania, USA
    Thanked 0 Times in 0 Posts
    No, not those types of columns.

    I have a worksheet with 4 columns of date and about 500 rows that I'd like to print out. It seems a great waste of paper to print the thing, as the existing columns only go about a third of the way across the paper. Yet if I break up the column of data on the worksheet itself, I lose formula integrity. Is there a way to format the printing so that I am using more of each sheet of paper i.e. a two or three column document?


    Bob Sullivan

  2. #2
    Platinum Lounger
    Join Date
    Feb 2001
    Weert, Limburg, Netherlands
    Thanked 0 Times in 0 Posts
    Maybe this little macro helps:

    Sub PrintOnMultiplePages()
      Dim iRows As Integer, iCols As Integer
      iRows = Val(InputBox("How many rows per page?"))
      iCols = Val(InputBox("How many columns per page?"))
      If iRows <= 0 Or iCols <= 0 Then
    	MsgBox "Invalid"
    	Exit Sub
      End If
      Multi_ColumnPrint iRows, iCols
    End Sub
    Sub Multi_ColumnPrint(iRows As Integer, iCols As Integer)
      ' prints table starting at A1 in active sheet in multi-column format
      ' the first row of each page is titles
      ' there are iRows printed on each page including titles
      ' in iCols columns with a blank column between each set.
      Dim oActive As Object, oTemp As Object
      Dim iDestRow As Integer, iDestCol As Integer, i As Integer
      Set oActive = ActiveSheet
      ' create a temporary sheet to format the printout
      Set oTemp = Worksheets.Add
      oTemp.Name = "Temp"
      ' copy the data into the desired numbers of columns
      ' assuming range to print is block starting A1
      ' and first row is headings
      With oActive.Range("A1").CurrentRegion
    	' set up headings
    	For i = 1 To iCols
    	  With oTemp.Cells(1, (i - 1) * (.Columns.Count + 1) + 1)
    		.PasteSpecial xlValues
    		.PasteSpecial xlFormats
    	  End With
    	oTemp.PageSetup.PrintTitleRows = "$1:$1"
    	iDestRow = 2
    	iDestCol = 1
    	For i = 2 To .Rows.Count Step iRows - 1  ' -1 because of heading row
    	  .Offset(i - 1).Resize(iRows - 1).Copy
    	  oTemp.Cells(iDestRow, iDestCol).PasteSpecial xlValues
    	  oTemp.Cells(iDestRow, iDestCol).PasteSpecial xlFormats
    	  If iDestCol = (iCols - 1) * (.Columns.Count + 1) + 1 Then
    		' have just done the last column of this page
    		iDestCol = 1
    		' move down on destination sheet
    		iDestRow = iDestRow + iRows - 1
    		' insert a page break
    		oTemp.Cells(iDestRow, 1).PageBreak = xlManual
    		iDestCol = iDestCol + .Columns.Count + 1  ' leave a spare column
    	  End If
    	Next i
      End With
      ' print preview the temporary sheet
      ' lose the temporary sheet
      Application.DisplayAlerts = False
      Application.DisplayAlerts = True
    End Sub
    Jan Karel Pieterse
    Microsoft Excel MVP, WMVP
    Professional Office Developers Association

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts