VBA - Save Worksheets as Individual PDFs

[Small Paul]

Hi

I have searched various websites/forums and tried the solutions but without success. I am hoping somebody here can help on this issue.

The code below basically has 3 stages:
1) Create a new folder and save the master file (this works properly)
2) Save the active sheet as a pdf (this does not work AT ALL)
3) Select next worksheet (this works properly)

Sub Comms_Statements_Save_As_PDFs()'
' Save_As_PDFs Macro


    Dim Path As String
    Dim d As String
    Dim sh As Worksheet


    Dim WS_Count As Integer
    Dim strFolder As String
    Dim strFile As String
    Dim I As Integer
    d = Format(Date, "yyyy-mm-dd")
    
'create folder
    strFolder = "Z:\Paul\Commission Paid\"
    strFile = activesheet.range("B4").value
    strFolder2 = "Z:\Paul\Commission Paid\" & d
    
    Path = "Z:\Paul\Commission Paid\"
    If Len(Dir(Path, vbDirectory)) = 0 Then
    MsgBox "Path does not exist.", vbCritical
    Exit Sub
    End If
    If Len(Dir(Path & d, vbDirectory)) = 0 Then MkDir (Path & d)
    ActiveWorkbook.SaveAs Filename:=strFolder & d & "\" & " " & "Commission Statements" & ".xlsm"
    Sheets("1").Activate


'Convert Each Sheet to PDF and Save
    WS_Count = ActiveWorkbook.Worksheets.Count
    For I = 3 To Sheets.Count
    range("B4").Select
    activesheet.ExportAsFixedFormat Type:=xlTypePDF
    Filename = strFolder2 & "\" & strFile & ".pdf"
    quality = xlQualityStandard
    includedocproperties = True
    ignoreprintareas = False
    openafterpublish = False
    I = I + 1
    activesheet.Next.Select
    Next
    End Sub

I need:
- each worksheet (from 3 to 'variable') to be saved as an individual PDF
- in the newly created folder - Z:\Paul\Commission Paid\[today's date]
- with a file name using the contents of cell B4 on each worksheet

Any and all assistance appreciated.

Cheers
Small Paul.

 

[Fluff]

Try

   For i = 3 To Sheets.Count
      With Sheets(i)
         strFile = .Range("B4").Value
         .ExportAsFixedFormat Type:=xlTypePDF
            Filename = strFolder2 & "\" & strFile & ".pdf"
            quality = xlQualityStandard
            includedocproperties = True
            ignoreprintareas = False
            openafterpublish = False
      End With
   Nexti

 

[Small Paul]

Hi Fluff

It does not like the line:

[COLOR=#333333]strFile = .Range("B4").Value[/COLOR]

I get a Compile Error: Invalid or Unqualified Reference

 

[Fluff]

Did you add this line

      With Sheets(i)

Also the Nexti should be Next i

 

[Small Paul]

I tried it initially as a replacement in my original code - from 'Convert each sheet ....' without success.

I have now set it is a separate macro (below).

Sub Fluff_PDF()'
' Fluff_PDF Macro
'
   For I = 3 To Sheets.Count
      With Sheets(I)
         strFile = .range("B4").value
         .ExportAsFixedFormat Type:=xlTypePDF
            Filename = "Z:\Paul\Commission Paid" & "\" & strFile & ".pdf"
            quality = xlQualityStandard
            includedocproperties = True
            ignoreprintareas = False
            openafterpublish = False
      End With
   Next I
'
End Sub

The only line which seems to action is the 'export as fixed format' - the machine does think about that for a moment!

 

[Small Paul]

Missed off Dim I As Integer - now added

When hovering mouse over

Filename = "Z:\Paul\Commission Paid" & "\" & strFile & ".pdf"

it gives me the correct filename

 

[Fluff]

Try

   For i = 3 To Sheets.Count
      With Sheets(i)
         strFile = .Range("B4").Value
         .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=strFolder2 & "\" & strFile & ".pdf", _
            quality:=xlQualityStandard, _
            includedocproperties:=True, _
            ignoreprintareas:=False, _
            openafterpublish:=False
      End With
   Next i

 

[Small Paul]

Fluff

Absolutely perfect, as ever.

Thank you very much.

Cheers
Small Paul.

 

[Fluff]

You're welcome & thanks for the feedback

 

[Small Paul]

This is bizarre!

Everything works great ...... except:
Where the name (in cell B4) of a tab is the same as that in another tab, only 1 saves. This is to be expected. So, I have added a piece to the filestring which picks up the currency - last row in column I. It is not possible for 2 sheets to have the same name & currency.

   For I = 3 To Sheets.Count      With Sheets(I)
      strFolder = "Z:\Paul\Commission Paid\" & d
         strFile = .range("B4").value & " " & range("I" & Rows.Count).End(xlUp)
         .ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=strFolder & "\" & strFile & ".pdf", _
            quality:=xlQualityStandard, _
            includedocproperties:=True, _
            ignoreprintareas:=False, _
            openafterpublish:=False
      End With
   Next I

When I have re-run the macro, it still only saves the one sheet rather than both. E.g. Joe Bloggs GBP saves and Joe Bloggs USD does not!!

Any suggestions?

Cheers
Small Paul.