I've copied/modified the following code from Ron de Bruin's original macros found here:
http://msdn.microsoft.com/en-us/library/ee834871(office.11).aspx
Macro & supporting function:
Sub RDB_Worksheet_Or_Worksheets_To_PDF()
Dim FileName As String
Dim ws As Worksheet
Dim pathName As String
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Master sheet" Then 'The sheet you don't want to print
'Do nothing
Else
pathName = ThisWorkbook.Path & "" & ws.Name & ".pdf"
'Call the function with the correct arguments.
'You can also use Sheets("Sheet3"
instead of ActiveSheet in the code(the sheet does not need to be active then).
FileName = RDB_Create_PDF(ws, pathName, True, True)
'For a fixed file name and to overwrite it each time you run the macro, use the following statement.
'RDB_Create_PDF(ActiveSheet, "C:UsersRonTestYourPdfFile.pdf", True, True)
If FileName <> "" Then
'Uncomment the following statement if you want to send the PDF by e-mail.
'RDB_Mail_PDF_Outlook FileName, "ron@debruin.nl", "This is the subject", _
"See the attached PDF file with the last figures" _
& vbNewLine & vbNewLine & "Regards Ron de bruin", False
Else
MsgBox "It is not possible to create the PDF; possible reasons:" & vbNewLine & _
"Add-in is not installed" & vbNewLine & _
"You canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to save the file is not correct" & vbNewLine & _
"PDF file exists and you canceled overwriting it."
End If
End If
Next ws
End Sub
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant
'Test to see if the Microsoft Create/Send add-in is installed.
If Dir(Environ("commonprogramfiles"
& "Microsoft SharedOFFICE" _
& Format(Val(Application.Version), "00"
& "EXP_PDF.DLL"
<> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the PDF file.
FileFormatstr = "PDF Files (*.pdf), *.pdf"
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF"
'If you cancel this dialog, exit the function.
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
'If OverwriteIfFileExist = False then test to see if the PDF
'already exists in the folder and exit the function if it does.
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
'Now export the PDF file.
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _ />IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If the export is successful, return the file name.
If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
StrSubject As String, StrBody As String, Send As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application"
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = StrTo
.CC = ""
.BCC = ""
.Subject = StrSubject
.Body = StrBody
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Macro prints every worksheet not named "Master sheet" (so you can change this to whatever the feeder sheet name is) and saves them using the worksheet name to the same folder as XL file. Modify the way the pathName is constructed if you need a different file name and/or location. Also, note that I've included the mail function, in case you want to create and mail the files in same go. Will need to modify macro to include email addresses and proper subject/body context.
Additional reading:
http://www.rondebruin.nl/pdf.htm
