EXCEL 将多个 Sheet 工作表打印在一个页面

在 EXCEL 工作簿中可以包含各种数据。如果有一个包含多个 Sheet 工作表的工作簿，每个工作表只包含少量数据，那么是否有方法可以在同一张纸上打印多个工作表呢？

许多人为了合并打印的内容，会创建了一个“打印工作表”，将工作簿中所有工作表上要打印的区域复制在一起。这样就可以将所有工作表中的内容打印在一起了，但是这种方法实在是有点麻烦。

要将多个工作表合并为一个工作表进行打印，可以通过宏来自动化实现。以下宏将在工作簿末尾创建一个新工作表，并将所有其他工作表中的内容复制到其中。

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

组合的工作表放在一起后，宏使用打印预览显示工作表。当关闭打印预览时，它会询问要打印多少份工作表。如果输入一个大于零的数字，则会打印对应份数。最后，宏会在完成之前删除组合工作表。