Non-adjacent print areas - 1 page

[Eltheza]

Hi All!

In Excel 2010, is it in any way possible to print non-contiguous print areas on a single page?

 

[jimrward]

Are they all on one worksheet or separate worksheets

 

[Eltheza]

Hi - thanks for replying!

They're all on one worksheet.

 

[jimrward]

I have code which goes thru each sheet and gets the defined print area and copies them all to a new sheet and then you can print that sheet

If you know all of the ranges on the sheet I am sure they could be selected and copied to a new sheet the same

How are your ranges defined, with names or actual ranges

 

[Eltheza]

Hi again, Jim!

Thanks very much! I'm not sure I want to get that complicated.

But if you can tell me how to define my ranges and then print on one sheet, I'd be interested!

At the mo', my ranges are just select > set print area. I haven't named them. Would that be better?

 

[jimrward]

ok here is the code I found on the net and adapted for my needs, where each sheet had a print area

obviously we need to change the process for your requirement, and either hold a list of all your areas, and the order you want them printed, and change the code below, its the line
.Range(.PageSetup.PrintArea).Copy
which we need to use to point to the range we want to copy, and loop thru the list accordingly

Sub Copy_Print_Areas()
    Dim wshTemp As Worksheet, wsh As Worksheet
    Dim lDestRw As Long
    
    Application.ScreenUpdating = False
    Set wshTemp = Sheets.Add(After:=Worksheets(Worksheets.Count))
    For Each wsh In ActiveWorkbook.Worksheets
        With wsh
            If .Name <> wshTemp.Name And .Name <> "Setup" Then
                If .ProtectContents = True Then
                    .Unprotect
                End If
                If .PageSetup.PrintArea <> "" Then
                    With wshTemp.UsedRange
                        lDestRw = .Row + .Rows.Count + 2
                    End With
                    .Range(.PageSetup.PrintArea).Copy
                    wshTemp.Cells(lDestRw, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                    wshTemp.Cells(lDestRw, 1).PasteSpecial Paste:=xlPasteColumnWidths
                    wshTemp.Cells(lDestRw, 1).PasteSpecial Paste:=xlPasteFormats
                    Cells.EntireColumn.AutoFit
                End If
            End If
        End With
    Next wsh
    Application.ScreenUpdating = True
End Sub

 

[Eltheza]

Very much obliged to you, Jim!

Thanks for taking the time to do this. I've bookmarked this thread for future reference.

 

[jimrward]

i will try and put together macro for different ranges on a sheet, should be too tricky

 

[jimrward]

ok here is something crude to get things going, I am sure the purists will be able to embellish and improve

copies various ranges from sheet called jim, to a new sheet, leaving 2 lines between each block

Sub Copy_Print_Areas()
    Dim wshTemp As Worksheet
    Dim lDestRw As Long
    
    Dim myRanges(4) As String
    myRanges(1) = "A3:C6"
    myRanges(2) = "F6:H12"
    myRanges(3) = "A5:F7"
    myRanges(4) = "F9:H15"
    
    Application.ScreenUpdating = False
    Set wshTemp = Sheets.Add(After:=Worksheets(Worksheets.Count))
    For j = 1 To 4
        With wshTemp.UsedRange
            lDestRw = .Row + .Rows.Count + 2
        End With
        ActiveWorkbook.Sheets("jim").Range(myRanges(j)).Copy
        wshTemp.Cells(lDestRw, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        wshTemp.Cells(lDestRw, 1).PasteSpecial Paste:=xlPasteColumnWidths
        wshTemp.Cells(lDestRw, 1).PasteSpecial Paste:=xlPasteFormats
        Cells.EntireColumn.AutoFit
    Next j
    Application.ScreenUpdating = True
End Sub