한 페이지에 여러 워크 시트 인쇄 (Microsoft Excel)

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