한 페이지에 여러 워크 시트 인쇄 (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