How to print multiple named ranges on multiple sheets using VBA?

M

msb1977

Board Regular
Joined
Apr 22, 2016
Messages
78
Hi all - after reading through many posts I decided to register and post this question because I never could adapt other people's stuff to my work. I'm definitely a beginner with VBA! Anyways, I'll try to explain what I'm trying to accomplish below. Any help would be greatly appreciated.

sheet 1 contains named ranges A and B
sheet 2 contains named ranges C and D

If it matters, ranges A and B have the same # of columns but different # of rows and the same for ranges C and D.

I want to print all to 1 .pdf in a specific order: sheet 1, range A; sheet 2, range C; sheet 1, range B; and sheet 2, range D.

To complicate matters, I need page breaks between all 4 ranges and also range C needs an internal page break and range D needs an internal page break (both at specific rows). Ends up being a total of 6 pages when printed.

As far as print set-up is concerned:
Landscape
Margins: left/right 0.25, top/bottom 0.5, center horizontally
Header: "text" upper left, "text" middle, date on the right
Footer: file name bottom left, "text" middle, page number bottom right

Could someone please help point me in the right direction? Again, any help is greatly appreciated.

Side note: Over the past week I have taught myself (by reading this forum) how to write the VBA code to open a file off a server, filter a table on multiple columns for multiple criteria, copy visible cells only, and paste that into a different workbook...as well as copy the formulas on that worksheet to match the # of rows copied over.

Thanks to you all for allowing me to take bits and pieces of your work and put it into mine.
 
Sort by date Sort by votes
Copy the four ranges, in order, to a new worksheet then insert the page breaks and save the worksheet as PDF. All these steps can easily be recorded to a macro. If you record the macro and post the code here, someone could help clean up.
 
Upvote 0
Thanks AlphaFrog. Recording the page set-up and page breaks worked perfectly. I think I have it *mostly* working now. However, I still have two questions and wouldn't mind some assistance with clean-up of the code.

Questions:
1. The 1st and 2rd ranges of the print area don't print to full scale. It looks like they are adjusting to the scaled down areas of ranges 2 and 4. Is there a way to make this adjustment?
2. Can I make all 4 print areas dynamic (calculate last row)? They will periodically change in size - mainly print areas 2 and 4.

Thanks for the help!

Code: 
Sub PrintSOF()

'Add worksheet to Copy and Paste SOF Ranges
Sheets.Add.Name = "PrintSOF"
Sheets("PrintSOF").Activate
Columns("A").ColumnWidth = 12
Columns("B").ColumnWidth = 16
Columns("C:I").ColumnWidth = 12
Columns("J").ColumnWidth = 21
Columns("K").ColumnWidth = 16
Columns("L").ColumnWidth = 25
Columns("M:U").ColumnWidth = 17
Columns("V").ColumnWidth = 12
Columns("W").ColumnWidth = 16
Columns("X:AD").ColumnWidth = 12
Columns("AE").ColumnWidth = 21
Columns("AF").ColumnWidth = 16
Columns("AG").ColumnWidth = 25
Columns("AH:AP").ColumnWidth = 17

'Copy and paste FY15 and FY16 SOF Executive Summary and Detail in specified order
Sheets("SOF ExSum").Range("FY16_SOF_ExSum").Copy
Sheets("PrintSOF").Range("A1").PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("A1").PasteSpecial xlPasteFormats

Sheets("SOF Rpt").Range("FY16_SOF").SpecialCells(xlCellTypeVisible).Copy
Sheets("PrintSOF").Range("J1").PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("J1").PasteSpecial xlPasteFormats

Sheets("SOF ExSum").Range("FY15_SOF_ExSum").Copy
Sheets("PrintSOF").Range("V1").PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("V1").PasteSpecial xlPasteFormats

Sheets("SOF Rpt").Range("FY15_SOF").SpecialCells(xlCellTypeVisible).Copy
Sheets("PrintSOF").Range("AE1").PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("AE1").PasteSpecial xlPasteFormats

'Prepare settings on page set-up and apply page breaks
Application.PrintCommunication = False
 With ActiveSheet.PageSetup
   .PrintTitleRows = ""
   .PrintTitleColumns = ""
 End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$16,$J$1:$U$91,$V$1:$AD$16,$AE$1:$AP$73"
Application.PrintCommunication = False
 With ActiveSheet.PageSetup
   .LeftMargin = Application.InchesToPoints(0.2)
   .RightMargin = Application.InchesToPoints(0.2)
   .TopMargin = Application.InchesToPoints(0.5)
   .BottomMargin = Application.InchesToPoints(0.5)
   .HeaderMargin = Application.InchesToPoints(0.3)
   .FooterMargin = Application.InchesToPoints(0.3)
   .PrintHeadings = False
   .PrintGridlines = False
   .PrintComments = xlPrintNoComments
   .PrintQuality = 1200
   .CenterHorizontally = True
   .CenterVertically = False
   .Orientation = xlLandscape
   .Draft = False
   .PaperSize = xlPaperLetter
   .FirstPageNumber = xlAutomatic
   .Order = xlDownThenOver
   .BlackAndWhite = False
   .Zoom = False
   .FitToPagesWide = 1
   .FitToPagesTall = 10
   .PrintErrors = xlPrintErrorsDisplayed
   .OddAndEvenPagesHeaderFooter = False
   .DifferentFirstPageHeaderFooter = False
   .ScaleWithDocHeaderFooter = True
   .AlignMarginsHeaderFooter = True
 End With
Application.PrintCommunication = True
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.ResetAllPageBreaks
 Set ActiveSheet.HPageBreaks(1).Location = Range("J57")
 Set ActiveSheet.HPageBreaks(2).Location = Range("AE49")

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
   Filename:="C:\Users\abc\Desktop\Status of Funds (as of XX-XX-XXXX).pdf", _
   Quality:=xlQualityStandard, IncludeDocProperties:=True, _
   IgnorePrintAreas:=False, OpenAfterPublish:=True
         
'Delete worksheet
Application.DisplayAlerts = False
Sheets("PrintSOF").Delete
Application.DisplayAlerts = True

End Sub
 
Upvote 0
This is what I attempted to make the multiple print area ranges dynamic, but it did not work. Any ideas?

Code: 
Dim lRow1 As Long, lRow2 As Long, lRow3 As Long, lRow4 As Long
 With ActiveSheet
   lRow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
   lRow2 = .Cells(.Rows.Count, "J").End(xlUp).Row
   lRow3 = .Cells(.Rows.Count, "AD").End(xlUp).Row
   lRow4 = .Cells(.Rows.Count, "AE").End(xlUp).Row
 End With
ActiveSheet.PageSetup.PrintArea = "A1 & lRow1,J1 & lRow2,V1 & lRow3,AE1 & lRow4 + 1)"
 
Upvote 0
Well done on recording and cleaning up your own macro. Looks very good to me.

1.) I'm not sure I follow what you want in scaling the pages differently? I don't know of a way to have different scaling for each page or print area. That doesn't mean it can't be done. Only that I don't know how to do it. You may have to just set it to some one-size-fits-all compromise e.g.;
Code: 
       .Zoom = [B]85[/B]   [COLOR=#008000]'Zoom percent[/COLOR]
[COLOR=#008000]       '.FitToPagesWide = 1[/COLOR]
[COLOR=#008000]       '.FitToPagesTall = 10[/COLOR]
2.) I think this will find the last row for each print area (not tested).
Code: 
[COLOR=#008000]    'ActiveSheet.PageSetup.PrintArea = "$A$1:$I$16,$J$1:$U$91,$V$1:$AD$16,$AE$1:$AP$73"[/COLOR]
    ActiveSheet.PageSetup.PrintArea = "$A$1:$I$" & Range("A" & Rows.Count).End(xlUp).Row & _
                                      ",$J$1:$U$" & Range("J" & Rows.Count).End(xlUp).Row & _
                                      ",$V$1:$AD$" & Range("V" & Rows.Count).End(xlUp).Row & _
                                      ",$AE$1:$AP$" & Range("AE" & Rows.Count).End(xlUp).Row

Do you want to calculate the rows for horizontal page breaks as well? If yes, by what criteria?
 
Upvote 0
msb1977 said:
This is what I attempted to make the multiple print area ranges dynamic, but it did not work. Any ideas?

Code: 
Dim lRow1 As Long, lRow2 As Long, lRow3 As Long, lRow4 As Long
 With ActiveSheet
   lRow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
   lRow2 = .Cells(.Rows.Count, "J").End(xlUp).Row
   lRow3 = .Cells(.Rows.Count, "AD").End(xlUp).Row
   lRow4 = .Cells(.Rows.Count, "AE").End(xlUp).Row
 End With
ActiveSheet.PageSetup.PrintArea = "A1 & lRow1,J1 & lRow2,V1 & lRow3,AE1 & lRow4 + 1)"
Click to expand...

ActiveSheet.PageSetup.PrintArea = "$A1:I" & lRow1 & ",J1:U" & lRow2 & ",V1:AD" & lRow3 & ",AE1:AP" & lRow4
 
Upvote 0
AlphaFrog said:
Well done on recording and cleaning up your own macro. Looks very good to me.

1.) I'm not sure I follow what you want in scaling the pages differently? I don't know of a way to have different scaling for each page or print area. That doesn't mean it can't be done. Only that I don't know how to do it. You may have to just set it to some one-size-fits-all compromise e.g.;
Code: 
       .Zoom = [B]85[/B]   [COLOR=#008000]'Zoom percent[/COLOR]
[COLOR=#008000]       '.FitToPagesWide = 1[/COLOR]
[COLOR=#008000]       '.FitToPagesTall = 10[/COLOR]
2.) I think this will find the last row for each print area (not tested).
Code: 
[COLOR=#008000]    'ActiveSheet.PageSetup.PrintArea = "$A$1:$I$16,$J$1:$U$91,$V$1:$AD$16,$AE$1:$AP$73"[/COLOR]
    ActiveSheet.PageSetup.PrintArea = "$A$1:$I$" & Range("A" & Rows.Count).End(xlUp).Row & _
                                      ",$J$1:$U$" & Range("J" & Rows.Count).End(xlUp).Row & _
                                      ",$V$1:$AD$" & Range("V" & Rows.Count).End(xlUp).Row & _
                                      ",$AE$1:$AP$" & Range("AE" & Rows.Count).End(xlUp).Row

Do you want to calculate the rows for horizontal page breaks as well? If yes, by what criteria?
Click to expand...
This works perfectly. Thank you!

Calculating the horizontal page break would be awesome too. I don't know if it is possible though. I would need to insert the breaks in column J and column AE, directly above the text "O&M 2P".

As far as the zoom, I am fitting everything to 1 page wide. Print ranges 2 and 4 have several more columns than print ranges 1 and 3. In order to fit print ranges 3 and 4 to the width of a page it has to shrink the data. Unfortunately, it also shrinks print ranges 1 and 3 by the same ratio. Print ranges 1 and 3 are an executive summary so I would like to avoid the shrinking. Not sure if this makes sense...
 
Upvote 0
msb1977 said:
This works perfectly. Thank you!

Calculating the horizontal page break would be awesome too. I don't know if it is possible though. I would need to insert the breaks in column J and column AE, directly above the text "O&M 2P".

As far as the zoom, I am fitting everything to 1 page wide. Print ranges 2 and 4 have several more columns than print ranges 1 and 3. In order to fit print ranges 3 and 4 to the width of a page it has to shrink the data. Unfortunately, it also shrinks print ranges 1 and 3 by the same ratio. Print ranges 1 and 3 are an executive summary so I would like to avoid the shrinking. Not sure if this makes sense...
Click to expand...

You're welcome.

Try this for the page breaks. It doesn't have error checking if no match is found.
Code: 
    ActiveSheet.ResetAllPageBreaks
     Set ActiveSheet.HPageBreaks(1).Location = Range("J:J").Find("O&M 2P", , , xlWhole, 1, 1, False)
     Set ActiveSheet.HPageBreaks(2).Location = Range("AE:AE").Find("O&M 2P", , , xlWhole, 1, 1, False)

As far as the scaling, I follow your description. Unfortunately, I don't have a perfect solution. Perhaps if you change the font size on the two areas to make them bigger or smaller relative to the other two areas?
 
Upvote 0
Page breaks worked perfectly. In order to adjust font size to get rid of the scaling problem when printing I ended up staggering the copy/paste because I had to adjust row height significantly. In the course of doing this I also made the paste of print ranges 2 and 4 dynamic as well as made the horizontal page break dynamic.

Thanks so much for your help. Is there a button or something I can click that denotes problem solved and that you helped solve it?

I am pasting the full code below that works perfectly now.

Code: 
Sub PrintSOF()

'Add worksheet to Copy and Paste SOF Ranges
Sheets.Add.Name = "PrintSOF"
Sheets("PrintSOF").Activate
Rows("1:16").RowHeight = 40
Columns("A").ColumnWidth = 22
Columns("B").ColumnWidth = 30
Columns("C:I").ColumnWidth = 22
Columns("J").ColumnWidth = 21
Columns("K").ColumnWidth = 16
Columns("L").ColumnWidth = 25
Columns("M:S").ColumnWidth = 17
Columns("T").ColumnWidth = 12
Columns("U").ColumnWidth = 17
Columns("V").ColumnWidth = 22
Columns("W").ColumnWidth = 30
Columns("X:AD").ColumnWidth = 22
Columns("AE").ColumnWidth = 21
Columns("AF").ColumnWidth = 16
Columns("AG").ColumnWidth = 25
Columns("AH:AN").ColumnWidth = 17
Columns("AO").ColumnWidth = 12
Columns("AP").ColumnWidth = 17

'Copy and paste FY15 and FY16 SOF Executive Summary and Detail in specified order
Sheets("SOF ExSum").Range("FY16_SOF_ExSum").Copy
Sheets("PrintSOF").Range("A1").PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("A1").PasteSpecial xlPasteFormats

Dim lRow1 As Long
With Sheets("PrintSOF")
  lRow1 = .Cells(.Rows.Count, "I").End(xlUp).Row
End With

Sheets("SOF Rpt").Range("FY16_SOF").SpecialCells(xlCellTypeVisible).Copy
Sheets("PrintSOF").Range("J" & lRow1 + 1).PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("J" & lRow1 + 1).PasteSpecial xlPasteFormats

Sheets("SOF ExSum").Range("FY15_SOF_ExSum").Copy
Sheets("PrintSOF").Range("V1").PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("V1").PasteSpecial xlPasteFormats

Dim lRow2 As Long
With Sheets("PrintSOF")
  lRow2 = .Cells(.Rows.Count, "AD").End(xlUp).Row
End With

Sheets("SOF Rpt").Range("FY15_SOF").SpecialCells(xlCellTypeVisible).Copy
Sheets("PrintSOF").Range("AE" & lRow2 + 1).PasteSpecial xlPasteValues
Sheets("PrintSOF").Range("AE" & lRow2 + 1).PasteSpecial xlPasteFormats

'Prepare settings on page set-up
Application.PrintCommunication = False
 With ActiveSheet.PageSetup
   .PrintTitleRows = ""
   .PrintTitleColumns = ""
 End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$I$" & Range("I" & Rows.Count).End(xlUp).Row & _
                                  ",$J$" & lRow1 + 1 & ":$U$" & Range("J" & Rows.Count).End(xlUp).Row & _
                                  ",$V$1:$AD$" & Range("AD" & Rows.Count).End(xlUp).Row & _
                                  ",$AE$" & lRow2 + 1 & ":$AP$" & Range("AO" & Rows.Count).End(xlUp).Row
Application.PrintCommunication = False
 With ActiveSheet.PageSetup
   .LeftMargin = Application.InchesToPoints(0.2)
   .RightMargin = Application.InchesToPoints(0.2)
   .TopMargin = Application.InchesToPoints(0.5)
   .BottomMargin = Application.InchesToPoints(0.5)
   .HeaderMargin = Application.InchesToPoints(0.3)
   .FooterMargin = Application.InchesToPoints(0.3)
   .PrintHeadings = False
   .PrintGridlines = False
   .PrintComments = xlPrintNoComments
   .PrintQuality = 1200
   .CenterHorizontally = True
   .CenterVertically = False
   .Orientation = xlLandscape
   .Draft = False
   .PaperSize = xlPaperLetter
   .FirstPageNumber = xlAutomatic
   .Order = xlDownThenOver
   .BlackAndWhite = False
   .Zoom = False
   .FitToPagesWide = 1
   .FitToPagesTall = False
   .PrintErrors = xlPrintErrorsDisplayed
   .OddAndEvenPagesHeaderFooter = False
   .DifferentFirstPageHeaderFooter = False
   .ScaleWithDocHeaderFooter = True
   .AlignMarginsHeaderFooter = True
 End With

'Adjust font size for SOF Executive Summary
Range("A2:I" & lRow1, "V2:AD" & lRow2).Select
 With Selection.Font
   .Name = "Calibri"
   .Size = 20
   .Strikethrough = False
   .Superscript = False
   .Subscript = False
   .OutlineFont = False
   .Shadow = False
   .Underline = xlUnderlineStyleNone
   .TintAndShade = 0
   .ThemeFont = xlThemeFontMinor
 End With
 
Range("A1:I1,V1:AD1").Select
 With Selection.Font
   .Name = "Calibri"
   .Size = 28
   .Strikethrough = False
   .Superscript = False
   .Subscript = False
   .OutlineFont = False
   .Shadow = False
   .Underline = xlUnderlineStyleNone
   .ColorIndex = xlAutomatic
   .TintAndShade = 0
   .ThemeFont = xlThemeFontMinor
 End With
    
'Adjust page breaks
Application.PrintCommunication = True
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.ResetAllPageBreaks
 Set ActiveSheet.HPageBreaks(1).Location = Range("J:J").Find("O&M 2P", , , xlWhole, 1, 1, False)
 Set ActiveSheet.HPageBreaks(2).Location = Range("AE:AE").Find("O&M 2P", , , xlWhole, 1, 1, False)

'Adjust Header & Footer
ActiveSheet.PageSetup.CenterHeader = "&B&14&KC00000FOR OFFICIAL USE ONLY"
ActiveSheet.PageSetup.LeftHeader = "&14Report: 1002_Based_SOF"
ActiveSheet.PageSetup.RightHeader = "&14&D"
ActiveSheet.PageSetup.CenterFooter = "&B&14&KC00000FOR OFFICIAL USE ONLY"
ActiveSheet.PageSetup.LeftFooter = "&L&14&F"
ActiveSheet.PageSetup.RightFooter = "&R&14&P"

'Print SOF Executive Summary and Details to PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
   Filename:="C:\Users\abc\Desktop\Status of Funds (as of XX-XX-XXXX).pdf", _
   Quality:=xlQualityStandard, IncludeDocProperties:=True, _
   IgnorePrintAreas:=False, OpenAfterPublish:=True
         
'Delete worksheet
Application.DisplayAlerts = False
Sheets("PrintSOF").Delete
Application.DisplayAlerts = True

End Sub
 
Upvote 0
Cool! Glad you were able to work it out. You write decent code for a self-proclaimed noob.

A couple of thoughts for what it's worth:

If you want the date in the PDF filename, use the FORMAT command to convert the date to a string then concatenate it within the filename.
Filename:="C:\Users\abc\Desktop\Status of Funds (as of " & Format(Date "mm-dd-yyyy") & ").pdf", _

If you want to paste the original column widths
Sheets("PrintSOF").Range("A1").PasteSpecial xlPasteColumnWidths
Or Autofit column widths (after pasting data and changing format)
Columns("A:W").Autofit


There's no "Solved" button for this forum. Just state it's solved and that's it.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

3
  • Question Question
Printing Multiple Sheets into One PDF
Replies
1
Views
140
3link
3
S
  • Solved
Need to print several named ranges based on the value of a cell
2 3
Replies
22
Views
416
stormseeker75
S
E
  • Solved
VBA to print two separate ranges on one sheet of paper
Replies
3
Views
157
EssKayKay
E
T
  • Solved
Copy all sheet contents from selected workbook and paste into current workbook sheets of the same name
Replies
2
Views
363
TurpsUK
T
R
  • Solved
Select method of Range class failed | Selecting a range
Replies
4
Views
258
rachel06
R

Share this page

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