Save certain sheets as PDF

[exl]

I have an excel workbook, where the end user does some selection, based on which the sheets which needs to be saved as a single PDF, are enlisted in Sheet 1, cell B10 like this (E1, E2, E3, E4...)

Now I have tried this macro below, but it does not work properly, the reasons are given below the code:

Sub pdff()

   Sheets("E1").Activate
   ActiveSheet.UsedRange.Select
   Sheets("E2").Activate
   ActiveSheet.UsedRange.Select
   Sheets("E3").Activate
   ActiveSheet.UsedRange.Select

   ThisWorkbook.Sheets(Array("E1", "E2","E3")).Select
   Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
      "C:\Users\Damon\Desktop\pdfmaker.pdf", Quality:=xlQualityStandard, _
      IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
      True
End Sub

The problems with the code:

• After the code runs, it groups the sheets together, which has to be ungrouped manually.
• The code saves the areas outside of the set print area (which does not happen if I save each sheet manually as PDF)
• The code is not dynamic, it does not pick up the sheet names from cell B10

Request help from the forum. Thanks

 

[CalcSux78]

• The ungrouping can be fixed by adding a sheet selection at the end
• Before printing setup your print area for each sheet. When you use the UsedRange method, you could get extra whitespace in your print range
• To make the selection dynamic, split the string for B2 into an array that can be used to setup the sheet selection

Sub pdff()
Dim ArrRng() As String
Dim sNames As String
Dim i As Integer
Dim Path As String

sNames = ThisWorkbook.Sheets(1).[B2]
ArrRng = Split(sNames, ",")
ThisWorkbook.Sheets(ArrRng(0)).Select

For i = LBound(ArrRng) To UBound(ArrRng)
    ThisWorkbook.Sheets(Trim(ArrRng(i))).Select False
Next i
ThisWorkbook.Sheets(ArrRng(0)).Activate

Path = CreateObject("WScript.Shell").specialfolders("Desktop")

ThisWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Path & "\pdfmaker.pdf", _
    OpenAfterPublish:=True
ThisWorkbook.Sheets(1).Select
End Sub

 

[exl]

Thanks