Export specific sheet(s) based on cell values into single Pdf

[Belalhp]

Hello... I'm having some difficulties... your help regarding the matter will be highly appreciated.

I have around 100 plus worksheets. 1^st sheet is the Summery Sheet, in column B I have worksheet names and based on the value in column G I want to print that worksheet.
If column G has “Y” value (e.g. in G2, G3 & G5) then the relevant worksheets (e.g. worksheet names mentioned in B2, B3 & B5) will be exported as single PDF file (named “Print”).

[TABLE="width: 86"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[TD="align: center"]G[/TD]
[/TR]
[TR]
[TD="align: center"]SL .No. [/TD]
[TD="align: center"]Work Sheet Name[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]Print Status[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]Summery Sheet[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]A One Polymer Ltd[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"]Y[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]Altech Aluninium Industries Ltd[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"]Y[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]Building Product & Service[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"][/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]Arif Kabir Enterprise[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD="align: center"]Y[/TD]
[/TR]
</tbody>[/TABLE]

I got the below VBA from another website (extendoffice) which only exports 1 sheet (last “Y”) rather than all the “Y”.

[COLOR=#000080]Sub CreateControlSheet()
'UpdatebyExtendoffice20170811
    Dim i As Integer
    Dim xCSheetRow As Integer
    Dim xSName As String
    Dim xCSheet As Variant
    Dim xRgVal As String
    On Error Resume Next
    xSName = "Summery Sheet"
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xCSheet = ActiveWorkbook.Worksheets(xSName)
    xCSheetRow = xCSheet.Range("G65536").End(xlUp).Row
    For i = 2 To xCSheetRow
        xRgVal = xCSheet.Range("G" & i).Value
        If xRgVal = "Y" Or xRgVal = "y" Then
            If xCSheet.Range("B" & i).Value <> "" Then
                ActiveWorkbook.Worksheets(xCSheet.Range("B" & i).Value).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                "C:\Users\Accounts\Desktop\Print.pdf", Quality:= _
                xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
                Sheets("Summery Sheet").Select
            End If
        End If
    Next
    Sheets("Summery Sheet").Select
    Range("G2:G500").Select
    Selection.Replace What:="y", Replacement:="C", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("G1").Select
    Application.ScreenUpdating = True
End Sub[/COLOR]

Thanks in advance for your time.

 

[Fluff]

Remove this line

[COLOR=#000080]On Error Resume Next[/COLOR]

and see what happens. I suspect that you get an error, if so what does the error message say & what line is highlighted if you click debug

 

[Belalhp]

No error occurred, I got a PDF file named Print in Desktop as usual which has only 1 page (the last sheet where I entered “y”).

 

[Fluff]

Ok, you're not changing the name of the Pdf file, so that it's just overwriting itself everytime

 

[Belalhp]

Thx for the help. Is there anyway solution?

 

[Fluff]

Try making this change

            If xCSheet.Range("B" & i).Value <> "" Then
                ActiveWorkbook.Worksheets(xCSheet.Range("B" & i).Value).Select
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
                "C:\Users\Accounts\Desktop\Prin[COLOR=#0000ff]t " & i & ".[/COLOR]pdf", Quality:= _
                xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
                Sheets("Summery Sheet").Select
            End If

 

[Belalhp]

Thx a lot.

 

[Fluff]

You're welcome