Please Note: This article is written for users of the following Microsoft Excel versions: 2007, 2010, 2013, 2016, 2019, Excel in Microsoft 365, and 2021. If you are using an earlier version (Excel 2003 or earlier), this tip may not work for you. For a version of this tip written specifically for earlier versions of Excel, click here: Printing Multiple Worksheets on a Single Page.
Written by Allen Wyatt (last updated October 14, 2023)
This tip applies to Excel 2007, 2010, 2013, 2016, 2019, Excel in Microsoft 365, and 2021
Workbooks can contain all sorts of data. If you have a workbook that includes a number of worksheets, each containing only a small amount of data, you may wonder if there is a way to print the multiple worksheets on a single sheet of paper.
There are a couple of ways that you can approach a solution to this problem. The first is simply print multiple pages per sheet, using the capabilities of your printer driver. For instance, the driver for my printer allows me to specify the number of pages to print per sheet of paper. If I wanted to print three or four single-page worksheets all on one piece of paper, all I need to do is follow these steps:
Not all printer drivers will have the capability, but yours may. You won't know, though, unless you do some exploring through the printer's Properties dialog box to find that capability. Of course, printing this way can lead to some very small text on the printout, because the printer driver simply reduces each page to occupy a proportionate area of the printed page. If you want to reduce some of the white space, and thereby increase the size of the printed text, then you need to look for a different solution.
Many people, to consolidate what is printed, actually create a "printing worksheet" which contains nothing but references to the areas to be printed on the other worksheets in the workbook. These references can either be done through formulas referring to the data on each worksheet, or by using the camera tool in Excel. (The camera tool has been described in other issues of ExcelTips.)
For an automated solution of amalgamating multiple worksheets into a single worksheet, you can use a macro. The following macro will create a new worksheet at the end of your workbook and copy the contents from all the other worksheets into it.
Sub PrintOnePage() Dim wshTemp As Worksheet, wsh As Worksheet Dim rngArr() As Range, c As Range Dim i As Integer Dim j As Integer ReDim rngArr(1 To 1) For Each wsh In ActiveWorkbook.Worksheets i = i + 1 If i > 1 Then ' resize array ReDim Preserve rngArr(1 To i) End If On Error Resume Next Set c = wsh.Cells.SpecialCells(xlCellTypeLastCell) If Err = 0 Then On Error GoTo 0 'Prevent empty rows Do While Application.CountA(c.EntireRow) = 0 _ And c.EntireRow.Row > 1 Set c = c.Offset(-1, 0) Loop Set rngArr(i) = wsh.Range(wsh.Range("A1"), c) End If Next wsh 'Add temp.Worksheet Set wshTemp = Sheets.Add(after:=Worksheets(Worksheets.Count)) On Error Resume Next With wshTemp For i = 1 To UBound(rngArr) If i = 1 Then Set c = .Range("A1") Else Set c = _ ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell) Set c = c.Offset(2, 0).End(xlToLeft) 'Skip one row End If 'Copy-paste range (prevent empty range) If Application.CountA(rngArr(i)) > 0 Then rngArr(i).Copy c End If Next i End With On Error GoTo 0 Application.CutCopyMode = False ' prevent marquies With ActiveSheet.PageSetup 'Fit to 1 page .Zoom = False .FitToPagesWide = 1 .FitToPagesTall = 1 End With 'Preview New Sheet ActiveWindow.SelectedSheets.PrintPreview 'Print Desired Number of Copies i = InputBox("Print how many copies?", "ExcelTips", 1) If IsNumeric(i) Then If i > 0 Then ActiveSheet.PrintOut Copies:=i End If End If 'Delete temp.Worksheet? If MsgBox("Delete the temporary worksheet?", _ vbYesNo, "ExcelTips") = vbYes Then Application.DisplayAlerts = False wshTemp.Delete Application.DisplayAlerts = True End If End Sub
After the combined worksheet is put together, the macro displays the worksheet using Print Preview. When you close Print Preview, it asks how many copies of the worksheet you want to print. If you enter a number greater than zero, then that many copies are printed. Finally, the macro offers to delete the combined worksheet for you just before finishing.
Note:
ExcelTips is your source for cost-effective Microsoft Excel training. This tip (8315) applies to Microsoft Excel 2007, 2010, 2013, 2016, 2019, Excel in Microsoft 365, and 2021. You can find a version of this tip for the older menu interface of Excel here: Printing Multiple Worksheets on a Single Page.
Program Successfully in Excel! John Walkenbach's name is synonymous with excellence in deciphering complex technical topics. With this comprehensive guide, "Mr. Spreadsheet" shows how to maximize your Excel experience using professional spreadsheet application development tips from his own personal bookshelf. Check out Excel 2013 Power Programming with VBA today!
Have you ever wanted to do a simple printout, only to find that Excel spit out dozens of pages, and most of them were ...
Discover MoreBorders not printing properly? It could be any one of a number of reasons causing the problem. This tip provides some ...
Discover MoreIt is common to select a group of worksheets and then print them. When done, any edits you make may affect the entire ...
Discover MoreFREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
2023-10-17 10:03:10
J. Woolley
The fix described in my previous comment below was incomplete. For the complete fix, locate the following statements
ActiveCell.RowHeight = .Height
If xWidth < .Width Then xWidth = .Width
End With
ActiveCell.Offset(1).Activate
and replace them with these statements
Dim nRows As Integer, i As Integer
nRows = 1 + (.Height \ 409)
For i = 1 To nRows
ActiveCell.Offset(i - 1).RowHeight = .Height / nRows
Next i
If xWidth < .Width Then xWidth = .Width
End With
ActiveCell.Offset(nRows).Activate
Sorry about the confusion.
2023-10-16 16:16:58
J. Woolley
Re. my most recent comment below, there is an error in the PrintOnePage2 macro. To fix it, locate the following statement
ActiveCell.RowHeight = .Height
and replace it with these statements
Dim nRows As Integer, i As Integer
nRows = 1 + (.Height \ 409)
For i = 1 To nRows
ActiveCell.Offset(i - 1).RowHeight = .Height / nRows
Next i
This is necessary because a row's height cannot exceed 409 points.
2023-10-16 14:00:04
J. Woolley
The Tip's macro does not preserve each worksheet's column widths or row heights, so the printed result might not look the same as the original worksheets. Here's an improved version that retains the look of each:
Sub PrintOnePage2()
Const WS_NAME = "...print", NOW_FMT = "mm/dd/yy hh:mm:ss"
Const MARGIN = 0.5
Dim oWF As WorksheetFunction, rUsed() As Range, xWidth As Double
Dim nCount As Integer, n As Integer
On Error Resume Next
Worksheets(WS_NAME).Activate
If Err = 0 Then
Application.DisplayAlerts = False
Worksheets(WS_NAME).Delete
Application.DisplayAlerts = True
End If
On Error GoTo 0
Set oWF = Application.WorksheetFunction
nCount = Worksheets.Count
ReDim rUsed(1 To nCount)
For n = 1 To nCount
With Worksheets(n)
If .Visible = xlSheetVisible And oWF.CountA(.UsedRange) > 0 Then
Set rUsed(n) = .UsedRange
End If
End With
Next n
With Worksheets.Add(After:=Sheets(Sheets.Count))
.Name = WS_NAME
.Cells(1, 1).Value = "Used ranges as of " & oWF.Text(Now(), NOW_FMT)
.Cells(2, 1).Formula = "=""Cell values as of ""&TEXT(NOW(),""" _
& NOW_FMT & """)"
.Cells(3, 1).Activate
With .Columns(1)
.Font.Name = "Courier New": .Font.Bold = True: .AutoFit
End With
ActiveWindow.DisplayGridlines = False
For n = 1 To nCount
If Not (rUsed(n) Is Nothing) Then
ActiveCell.Value = rUsed(n).Parent.Name
ActiveCell.Offset(1).Activate
rUsed(n).Copy
With .Pictures.Paste(Link:=True)
ActiveCell.RowHeight = .Height
If xWidth < .Width Then xWidth = .Width
End With
ActiveCell.Offset(1).Activate
End If
Next n
.Cells(1, 1).Activate
With ActiveCell
If .Width < xWidth Then
For n = 1 To 3
.ColumnWidth = xWidth * .ColumnWidth / .Width
Next n
End If
End With
With .PageSetup
n = Application.InchesToPoints(MARGIN)
.TopMargin = n: .BottomMargin = n
.LeftMargin = n: .RightMargin = n
.Zoom = False: .FitToPagesWide = 1: .FitToPagesTall = 1
End With
End With
Application.CutCopyMode = False
ActiveSheet.PrintPreview True
End Sub
The result is similar to using the Camera tool mentioned in the Tip or the DynamicImage macro in My Excel Toolbox. It is pratical only if the content of each worksheet is limited as specified in the Tip's first paragraph.
For related discussion, see:
https://excelribbon.tips.net/T012204_Printing_Multiple_Selections.html
https://excelribbon.tips.net/T008189_Multiple_Print_Areas_on_a_Single_Printed_Page.html
https://excelribbon.tips.net/T006789_Printing_Multiple_Worksheet_Ranges.html
Got a version of Excel that uses the ribbon interface (Excel 2007 or later)? This site is for you! If you use an earlier version of Excel, visit our ExcelTips site focusing on the menu interface.
FREE SERVICE: Get tips like this every week in ExcelTips, a free productivity newsletter. Enter your address and click "Subscribe."
Copyright © 2024 Sharon Parq Associates, Inc.
Comments