Combine worksheets and print to pdf

[pulevich]

Hi! This is my first time posting here although I've used a several examples to help me write basic macros.

I am completed stumped on a project that I thought would be fairly easy. I have an excel file that contains a worksheet for each site (location) that was included in a survey. I found the code below that allows me to print each worksheet and save it as a pdf with the worksheet name. What I can't figure out is how to append two worksheets to each pdf set which are basically cover pages. The first of these pages needs to have the value located in cell B1 of each worksheet into cell A7. The second cover page remains the same for all worksheets.

Option Explicit
Sub Print_PDFWorks()
Dim Awb As Workbook
Dim Snr As Integer
Dim ws As Worksheet
Set Awb = ActiveWorkbook




For Each ws In Awb.Sheets
    If Not ws.Name = "Sheet1" Then
        'Sheets(ws.Name).Copy
        Awb.Sheets(ws.Name).Copy
        'Sheets(ws.Name).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        Awb.Path & "\" & Awb.Sheets(ws.Name).Name & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
        
        ActiveWindow.Close False
    End If
Next ws




End Sub

I'm pretty new to writing macros so I think I'm in over my head on this one. I thought I could simply add line to copy the cover pages but those end up opening in separate files from the worksheets.

Thanks for any direction you can give me!

 

[John_w]

A tip to get you started: record a macro and select multiple sheets (1 sheet + the 2 sheets you want appended) and save as PDF. The generated code will show how to print multiple sheets as a PDF.

If you still need help, what are the names or positions (1st sheet, 2nd sheet, etc.) of the 2 sheets you want appended?

 

[pulevich]

A tip to get you started: record a macro and select multiple sheets (1 sheet + the 2 sheets you want appended) and save as PDF. The generated code will show how to print multiple sheets as a PDF.

If you still need help, what are the names or positions (1st sheet, 2nd sheet, etc.) of the 2 sheets you want appended?

Thank you! That really helped and I'm embarrassed I hadn't thought to do that before!

I've made progress today and now have a macro that will copy the first worksheet "Cover" with the second worksheet "Site A" to a new workbook, save it and print to a pdf. It also pulls the site name from cells B7:O7 in the "Site A" worksheet and copies that the cell A19 in the "Cover" worksheet. The filename then uses cell A19 in "Cover" to save the file.

Sub PrintReports()


Dim NewWB As Workbook
Dim sPrintArea As String
Dim wks As Worksheet


ActiveWorkbook.Sheets("Site A").Select
    Range("B7:O7").Select
    Selection.Copy
    Sheets("Cover").Select
    Range("A19").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Cover").Select
    Application.CutCopyMode = False
     Sheets("Cover").Copy


ActiveWorkbook.SaveAs FileName:="C:\Users\pulevich\Downloads\" & Range("A19").Value
Set NewWB = ActiveWorkbook


Windows("1602-25 MUFSD Emp Eng by Position and Longevity v2.xlsm").Activate


Sheets("Site A").Select
    Sheets("Site A").Copy After:=NewWB.Sheets("Cover")
    
ActiveSheet.PageSetup.PrintArea = "B7:O72"
ActiveSheet.PageSetup.Zoom = False
ActiveSheet.PageSetup.FitToPagesTall = 1
ActiveSheet.PageSetup.FitToPagesWide = 1


ActiveWorkbook.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False




End Sub
[Code]

I have not been able to figure out how to loop through each of the worksheets following "Site A" so that a separate pdf is created with "Cover"+"Site B", "Cover"+"Site C", etc. for all the worksheets. Any suggestions on what steps I should take next?

Thank you!

 

[John_w]

copy the first worksheet "Cover" with the second worksheet "Site A" to a new workbook, save it and print to a pdf.

That's the wrong approach - don't copy sheets to a new workbook. Maybe you misunderstood my tip, but you should select sheets, e.g. click the Sheet1 tab, press the Ctrl key and keep it down and click the Sheet2 tab, and release the Ctrl key. Sheets Sheet1 and Sheet2 are now selected. Now Save As PDF (selected Sheet(s) is the default option). This gives:

Sub Macro1()
    Sheets(Array("Sheet1", "Sheet2")).Select
    Sheets("Sheet1").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Files\Test PDF.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Sub

 

[pulevich]

That's the wrong approach - don't copy sheets to a new workbook. Maybe you misunderstood my tip, but you should select sheets, e.g. click the Sheet1 tab, press the Ctrl key and keep it down and click the Sheet2 tab, and release the Ctrl key. Sheets Sheet1 and Sheet2 are now selected. Now Save As PDF (selected Sheet(s) is the default option). This gives:

Sub Macro1()
    Sheets(Array("Sheet1", "Sheet2")).Select
    Sheets("Sheet1").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Files\Test PDF.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Sub

Hi! I'm not sure how that would work with 300 worksheets. How would I set the macro such that it prints each set without needing to specify each array?
Thanks!

 

[John_w]

I've made progress today and now have a macro that will copy the first worksheet "Cover" with the second worksheet "Site A" to a new workbook, save it and print to a pdf. It also pulls the site name from cells B7:O7 in the "Site A" worksheet and copies that the cell A19 in the "Cover" worksheet. The filename then uses cell A19 in "Cover" to save the file.

I have not been able to figure out how to loop through each of the worksheets following "Site A" so that a separate pdf is created with "Cover"+"Site B", "Cover"+"Site C", etc. for all the worksheets. Any suggestions on what steps I should take next?

Thank you!

Your OP talked about appending 2 cover sheets. If I understand you correctly, you now want to prepend 1 cover sheet (the first sheet) to all the other sheets.

Hi! I'm not sure how that would work with 300 worksheets. How would I set the macro such that it prints each set without needing to specify each array?
Thanks!

The code I posted shows the VBA syntax for selecting multiple sheets - an array of sheet names, so we simply loop through all the sheets from the second to the last, each time putting the first sheet name and the nth sheet name in the array for selection:

Public Sub Save_Each_Sheet_Plus_Cover_Sheet_As_PDF()

    Dim n As Integer
    
    With ThisWorkbook
        'Loop from 2nd worksheet to last
        For n = 2 To .Worksheets.Count
            'Copy nth sheet's B7:07 to 1st sheet's A19
            .Worksheets(n).Range("B7:O7").Copy .Worksheets(1).Range("A19")
            'Select 1st sheet and nth sheet
            .Worksheets(Array(.Worksheets(1).Name, .Worksheets(n).Name)).Select
            .Worksheets(1).Activate
            'Save both sheets as PDF using 1st sheet's A19 as file name
            .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & .Worksheets(1).Range("A19").Value & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        Next
    End With
    
End Sub

PS - you omitted a / on the closing code tag: [CODE]....[/CODE]

 

[pulevich]

Your OP talked about appending 2 cover sheets. If I understand you correctly, you now want to prepend 1 cover sheet (the first sheet) to all the other sheets.

The code I posted shows the VBA syntax for selecting multiple sheets - an array of sheet names, so we simply loop through all the sheets from the second to the last, each time putting the first sheet name and the nth sheet name in the array for selection:

Public Sub Save_Each_Sheet_Plus_Cover_Sheet_As_PDF()

    Dim n As Integer
    
    With ThisWorkbook
        'Loop from 2nd worksheet to last
        For n = 2 To .Worksheets.Count
            'Copy nth sheet's B7:07 to 1st sheet's A19
            .Worksheets(n).Range("B7:O7").Copy .Worksheets(1).Range("A19")
            'Select 1st sheet and nth sheet
            .Worksheets(Array(.Worksheets(1).Name, .Worksheets(n).Name)).Select
            .Worksheets(1).Activate
            'Save both sheets as PDF using 1st sheet's A19 as file name
            .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & .Worksheets(1).Range("A19").Value & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

        Next
    End With
    
End Sub

PS - you omitted a / on the closing code tag: [CODE]....[/CODE]

Hi! I'm sorry it took me so long to respond to your last post! I had to put this project aside for a few days then my boss threw in some new requirements (change charts to new template, change colors in dynamic tables, change font settings in table). Thank you so much for your help with this!

I found some time to work more on this yesterday and today and here is my final code!

Sub PrintReports()
Dim n As Integer
Dim cht As Chart


With ThisWorkbook
        'Loop from 2nd worksheet to last
        For n = 2 To .Worksheets.Count
            'Change chart colors
           .Worksheets(n).ChartObjects("Chart 1").Activate
             ActiveChart.ApplyChartTemplate ( _
                "C:\Users\pulevich\AppData\Roaming\Microsoft\Templates\Charts\2016Jan Engagement Scale.crtx" _
                 )
                 With ActiveChart.Parent
                    .Height = 180
                    .Width = 650
                    End With
            .Worksheets(n).Range("j41:m72").Select
                Selection.Font.Color = RGB(255, 255, 255)
                Selection.Font.Bold = True
            .Worksheets(n).Range("c36:m72").Select
            For Each cell In Selection
                If cell.Interior.Color = RGB(232, 68, 37) Then
                cell.Interior.Color = RGB(247, 43, 29)
                ElseIf cell.Interior.Color = RGB(254, 184, 31) Then
                cell.Interior.Color = RGB(241, 170, 25)
                ElseIf cell.Interior.Color = RGB(8, 135, 201) Then
                cell.Interior.Color = RGB(17, 65, 136)
                ElseIf cell.Interior.Color = RGB(99, 173, 68) Then
                cell.Interior.Color = RGB(83, 160, 53)
                End If
            Next cell
            
            .Worksheets(n).Range("B7:O7").UnMerge
            .Worksheets(n).Range("B7").Copy .Worksheets(1).Range("A19")
            'Select 1st sheet and nth sheet
            .Worksheets(Array(.Worksheets(1).Name, .Worksheets(n).Name)).Select
            .Worksheets(1).Activate
            'Save both sheets as PDF using 1st sheet's A19 as file name
            .ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=ThisWorkbook.Path & "\" & .Worksheets(1).Range("A19").Value & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


        Next
    End With
            
End Sub

These reports are not due to our client until next week so if you have suggestions for improving my code, I have time to make changes. I'm sure you know of more elegant way to get where I'm going!