print multiple worksheets to one page with review

lakke2120

New Member
Joined
Aug 21, 2014
Messages
32
Hello,
I found a VBA code that prints multiple worksheets to one page. It works well but it also prints hidden pages which I cant use and it prints the whole worksheet. I need it to print just the areas that contain data. Can anyone help with this. Thank you in advance

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
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
I think what is needed is to switch from
Code:
For Each wsh In ActiveWorkbook.Worksheets
to
Code:
For Each wsh In ActiveWindow.SelectedSheets

Select each of the desired worksheets to print using CTRL+LeftClick, then run macro
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,260
Members
452,627
Latest member
KitkatToby

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top