excel - Create Single PDF file rather than Multiple

Question

I have been using this code which create the multiple PDF files I want to keep all the Pictures in single PDF file but in separate pages.

I tried a lot to do but could not find how this thing will be happen. Your help will be really appreciated.

Sub ExpPdf()
  Dim sh As Worksheet, lastR As Long, rng As Range, arr, arrSplit, i As Long, k As Long
  
  Set sh = Sheet17
  lastR = sh.Range("C" & sh.Rows.Count).End(xlUp).Row
  
  ReDim arr(lastR - 1)
  For i = 6 To lastR
        If sh.Range("E" & i).Value = "Include" Then
            arr(k) = sh.Range("C" & i).Value & "|" & sh.Range("D" & i).Value: k = k + 1
        End If
  Next i
  If k > 0 Then
        ReDim Preserve arr(k - 1)
  Else
        MsgBox "No appropriate range (containing ""Include"") could be found...:exit sub"
  End If
  Dim boolHide As Boolean, boolProt As Boolean
  ActiveWorkbook.Unprotect "4321"
  For i = 0 To UBound(arr)
        boolHide = False: boolProt = False
        arrSplit = Split(arr(i), "|")
        Set rng = Worksheets(arrSplit(0)).Range(arrSplit(1))
        
        If ActiveWorkbook.Sheets(arrSplit(0)).ProtectContents Then _
                ActiveWorkbook.Sheets(arrSplit(0)).Unprotect "4321": boolProt = True
                Debug.Print arrSplit(0)
        If ActiveWorkbook.Sheets(arrSplit(0)).Visible <> xlSheetVisible Then _
                ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetVisible: boolHide = True
        
        
        Dim saveLocation As String
        
        saveLocation = ThisWorkbook.Path & "" & arrSplit(0) & ".pdf"
        
    
        rng.ExportAsFixedFormat Type:=xlTypePDF, FILENAME:= _
          saveLocation, Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=True
         If boolHide Then ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetHidden
         If boolProt Then ActiveWorkbook.Sheets(arrSplit(0)).Protect "4321"
  Next
  ActiveWorkbook.Protect "4321"
End Sub

Answer 1

Loop through each sheet and then set an PrintArea. The printarea will be the ranges you specify. Each PrintArea will then be exported to a single page in the PDF file.

Sub ExpPdf()
    Dim sh As Worksheet, lastR As Long, rng As Range, arr, arr2, arr3, arrSplit, i As Long, k, l, m As Long

    Set sh = Sheet17
    lastR = sh.Range("C" & sh.Rows.Count).End(xlUp).Row
    
    ReDim arr(lastR - 1)
    For i = 6 To lastR
          If sh.Range("E" & i).Value = "Include" Then
              arr(k) = sh.Range("C" & i).Value & "|" & sh.Range("D" & i).Value: k = k + 1
          End If
    Next i
    If k > 0 Then
          ReDim Preserve arr(k - 1)
    Else
          MsgBox "No appropriate range (containing ""Include"") could be found...:exit sub"
    End If
    Dim boolHide As Boolean, boolProt As Boolean
    ActiveWorkbook.Unprotect "4321" 'in order to unprotect he workbook structure
      
              
    'Create and assign variables
    Dim saveLocation As String
    saveLocation = ThisWorkbook.path & "" & Format(Now(), "mm-dd-yy, hh.mm.ss") & " - " & Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1) & ".pdf"
        
    ReDim arr2(UBound(arr))
    ReDim arr3(UBound(arr))
    For i = 0 To UBound(arr)
          boolHide = False: boolProt = False
          arrSplit = Split(arr(i), "|")
          If ActiveWorkbook.Sheets(arrSplit(0)).ProtectContents Then _
          ActiveWorkbook.Sheets(arrSplit(0)).Unprotect "4321": boolProt = True
          Debug.Print arrSplit(0)
          If ActiveWorkbook.Sheets(arrSplit(0)).Visible <> xlSheetVisible Then _
          ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetVisible: boolHide = True
          arr2(l) = arrSplit(0): l = l + 1
          arr3(m) = arrSplit(1): m = m + 1
    Next i
    
    Dim path As String
    Dim myArr As Variant, a As Variant
    
    For i = 0 To UBound(arr2)
        Set sh = Sheets(arr2(i))
        With sh
            .PageSetup.PrintArea = .Range(arr3(i)).Address
            Debug.Print .Range(arr3(i)).Address
        End With
    Next i
    Sheets(arr2).Select
    Debug.Print Sheets(arr2).Select
    
    
    'Save a range as PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    saveLocation, Quality:=xlQualityStandard, _
    IgnorePrintAreas:=False, OpenAfterPublish:= _
    False
    If boolHide Then ActiveWorkbook.Sheets(arrSplit(0)).Visible = xlSheetHidden
    If boolProt Then ActiveWorkbook.Sheets(arrSplit(0)).Protect "4321"
      
      
    ActiveWorkbook.Protect "4321"
End Sub

---

Don't forget to adjust your print area so you don't get empty pages: