Range export creates 50 individual PDFs - How to combine

user_15769417 0
Viewed 46

I have an excel Dashboard document where cell D1 has a dropdown of 50 rep names. When D1 changes, all data on the page changes. My code exports an individual PDF for each value in D1 and loads it to the rep's personal file on our drive. I would like to also take all 50 of these PDFs and merge them into one single PDF file for our management team to review and save it in a seperate folder. My code currently looks like this:

Sub MakeFiles()

Dim rep As String
Dim reppath As String
Dim path As String
Dim pathmanagement As String
Dim MyFileName As String
Dim myrange As Range
Dim i As Range
On Error GoTo errHandler


ActiveWorkbook.Sheets("REF").Visible = False
ActiveWorkbook.Sheets("Individual").Activate

path = "C:\Users\ph\vf\Reporting\"
pathmanagement = "C:\Users\ph\vf\Reporting\management"

Set myrange = Worksheets("REF").Range("A2", Worksheets("REF").Range("a2").End(xlDown))


For Each i In myrange


Worksheets("Individual").Range("d1").Value = i
Application.Calculate
rep = Worksheets("Individual").Range("d1").Value

ActiveWorkbook.Sheets("Individual").Activate


ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=path & ActiveSheet.Range("f1").Value & "\" & ActiveSheet.Range("g1").Value & "\" & "Territory Summary" & " " & ActiveSheet.Range("e1").Value & " " & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pathmanagement & "\" & "Rep Territory Summaries" & "\" & "Territory Summary" & " " & ActiveSheet.Range("e1").Value & ".pdf"

Next i

MsgBox "Done!"

Exit Sub

errHandler: MsgBox "Could not create PDF file."

End Sub

Is there something I can add to this code to also get a single PDF that will show the results of all 50 values in D1? Or if I upload copies of each file into a separate folder, is there code that will then automatically merge them into one PDF file?

vba excel pdf
1 Answers

Export Multiple Versions of a Worksheet to PDF

  • Not tested.
  • The following should loop through column A of Source and write each value to D1 of Destination which will generate a different version of Destination due to formulas recalculating. Then this version will be exported as PDF to two paths (initially) and it will be copied to a newly added workbook (the addition). Finally, the new workbook will be exported as PDF and closed without saving changes.
  • Adjust AnotherFilePath appropriately.
Option Explicit

Sub MakeFiles()

    Const RepPath As String = "C:\Users\ph\vf\Reporting\"
    Const ManPath As String = "C:\Users\ph\vf\Reporting\management\"
    
    On Error GoTo errHandler
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
        
    Dim dws As Worksheet: Set dws = wb.Worksheets("Individual")
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("REF")
    sws.Visible = False
    ' The following line assumes that the data doesn't contain any empty
    ' cells. Using `xlUp` is the preferred (usually safer) way.
    Dim srg As Range: Set srg = sws.Range("A2", sws.Range("A2").End(xlDown))
    
    Dim rwb As Workbook
    Dim sCell As Range
    Dim n As Long
    
    For Each sCell In srg.Cells
        
        dws.Range("D1").Value = sCell.Value
        Application.Calculate
        
        wb.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=RepPath & dws.Range("F1").Value & "\" _
            & dws.Range("G1").Value & "\" & "Territory Summary" _
            & " " & dws.Range("E1").Value & " " _
            & Format(DateAdd("m", -1, Date), "mmmm yyyy") & ".pdf"
        
        wb.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ManPath & "Rep Territory Summaries" & "\" _
            & "Territory Summary" & " " & dws.Range("e1").Value & ".pdf"
    
        n = n + 1
        If n = 1 Then
            dws.Copy ' adds a new workbook containing only the current 'dws'
            Set rwb = ActiveWorkbook
        Else
            dws.Copy After:=rwb.Sheets(rwb.Sheets.Count)
        End If
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
    
    Next sCell
    
    rwb.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:="AnotherFilePath" & ".pdf"
    rwb.Close False
    
    MsgBox "Exported " & n & " worksheets.", vbInformation, "PDF Export"
    
ProcExit:
    Exit Sub
errHandler:
    MsgBox "Could not create PDF file."
    Resume ProcExit
End Sub
user_98140690
Related