Trying to get multiple worksheets to print in particular order

[andyk1968]

I have a workbook with multiple sheets.

The first sheet is a summary, and the following sheets are used for adding new data.

I have a macro to convert one data sheet and the summary sheet to a pdf.

I would like the data sheet to be first, and the summary to follow, but I can't seem to get this to work.

Here's the code:

<code>Sub PrintCurrentSheetSummary()
Dim Current As String
Dim SheetIn As Integer
Dim SheetName As String
Dim NewFilename As String
Dim Path As String
Dim Filepath As String

NewFilename = "CO " & Cells(3, 1).Value & " MBE-WBE Worksheet and Summary"  ' the creates the new pdf file name
    Path = Cells(1, 14).Value ' the path is dependent on where the excel file is saved
    Filepath = Path + NewFilename + ".pdf"

SheetIn = ActiveSheet.Index
SheetName = Sheets(SheetIn).Name



Sheets(Array(SheetName, "Sheet1")).Select

'Sheets("Sheet1").Move after:=Sheets(SheetIn)

' this saves the pdf
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Filepath, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        True

'Sheets("Sheet1").Move before:=Sheets("MBE WBE SBE")
End Sub

</code>
Thanks!

 

[SpillerBD]

Selecting Multiple sheets to print, they will print left to right.
However, it looks like your Sheets(Array) may actually be changing that order(?)
Or am i misinterpreting your implied issue with the code?

I would also suggest that your reference to Cells(3,1) be more definitive and include the sheet reference.

 

[andyk1968]

Thanks for the tip on the cell reference. Will implement.

I thought that was the case on the print order.

I have tried to add code to temporarily reorder the sheets, but this leads to only one sheet printing.

 

[John_w]

Rather than reordering the two sheets, it's easier to copy them to a temporary new workbook.

Public Sub PrintCurrentSheetSummary()

    Dim NewFilename As String
    Dim Path As String
    Dim Filepath As String
    Dim tempWb As Workbook
    
    With ActiveSheet
        NewFilename = "CO " & .Range("A3").Value & " MBE-WBE Worksheet and Summary.pdf"  ' the creates the new pdf file name
        Path = .Range("N1").Value ' the path is dependent on where the excel file is saved
    End With
    Filepath = Path & NewFilename

    With ThisWorkbook
        .ActiveSheet.Copy
        Set tempWb = ActiveWorkbook
        .Worksheets("Sheet1").Copy After:=tempWb.Worksheets(1)
        tempWb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filepath, _
            Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        tempWb.Close False
        .ActiveSheet.Select True
    End With
    
    MsgBox "Created " & Filepath
    
End Sub

 

[andyk1968]

Nice!

Works like a charm John.

I never would have thought of that approach.

Thanks for your help.

 

[andyk1968]

John,

I discovered an problem with the code/my output.

Sheet1 has some calculated cells that rely on other sheets that won't be copied to the temp file.

Is there a way to copy the values and formats over? I have tried various modifications without success.

 

[John_w]

See if this works better.

Public Sub PrintCurrentSheetSummary2()

    Dim NewFilename As String
    Dim Path As String
    Dim Filepath As String
    Dim tempWb As Workbook
    
    With ActiveSheet
        NewFilename = "CO " & .Range("A3").Value & " MBE-WBE Worksheet and Summary.pdf"  'PDF file name
        Path = .Range("N1").Value                                                        'path where PDF will be created
    End With
    Filepath = Path & NewFilename

    Application.ScreenUpdating = False
    
    With ThisWorkbook
        Set tempWb = Workbooks.Add(xlWBATWorksheet)
        .ActiveSheet.Copy Before:=tempWb.Worksheets(1)
        .Worksheets("Sheet1").UsedRange.Copy
        tempWb.Worksheets(2).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
        tempWb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filepath, _
            Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        tempWb.Close False
        .ActiveSheet.Select True
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Created " & Filepath
    
End Sub

PS - the PDF Quality can be either xlQualityMinimum or xlQualityStandard with larger file size.

 

[andyk1968]

Closer. Added this code:

.Worksheets("Sheet1").Range("exportpdf").Copy
        tempWb.Worksheets(2).Range("A1").PasteSpecial xlPasteFormats
        tempWb.Worksheets(2).Range("A1").PasteSpecial xlPasteColumnWidths
        tempWb.Worksheets(2).Range("A1").PasteSpecial xlPasteValues

Just need to figure out how to make Sheet1 on the tempWb to print all columns on one sheet.

 

[andyk1968]

Added this code to get it all on one sheet wide:

With Worksheets("Sheet1").PageSetup
                .Zoom = False
                .FitToPagesTall = 17
                .FitToPagesWide = 1
        End With

Not satisfied the the pagestall "17", but not sure on how to set it to properly distribute columns evenly. Without, it creates sheets as 2 pages, and it can't be read.

 

[andyk1968]

Here's the entire code as I now have it:

Public Sub PrintCurrentSheetSummaryNew()
Dim NewFilename As String
    Dim Path As String
    Dim Filepath As String
    Dim tempWb As Workbook
    
    With ActiveSheet
        NewFilename = "CO " & .Range("A3").Value & " MBE-WBE Worksheet and Summary.pdf"  'PDF file name
        Path = .Range("N1").Value                                                        'path where PDF will be created
    End With
    Filepath = Path & NewFilename

    Application.ScreenUpdating = False
    
    With ThisWorkbook
        Set tempWb = Workbooks.add(xlWBATWorksheet)
        .ActiveSheet.Copy Before:=tempWb.Worksheets(1)
        .Worksheets("Sheet1").Range("exportpdf").Copy
        With Worksheets("Sheet1").PageSetup
                .Zoom = False
                .FitToPagesTall = 17
                .FitToPagesWide = 1
        End With
        tempWb.Worksheets(2).Range("A1").PasteSpecial xlPasteFormats
        tempWb.Worksheets(2).Range("A1").PasteSpecial xlPasteColumnWidths
        tempWb.Worksheets(2).Range("A1").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        tempWb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Filepath, _
            Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        tempWb.Close False
        .ActiveSheet.Select True
    End With
    
    Application.ScreenUpdating = True
    
    MsgBox "Created " & Filepath
    
End Sub