Hi Chantal,

You can use the code below to send all sheets one by one:

The code loops through sheets and calls your EmailScript procedure.

Hi

Thank you for your information.

I tried to paste it after my emailscript but it loops on the same page. How do I ask to move to the next worksheet until all of them are sent?

Also, what is the path format to automatically save in a particular folder?

thanks again

---------------------------------Script-------------------------------

Sub create_and_email_pdf()
' Create a PDF from the current sheet and email it as an attachment through Outlook

Dim EmailSubject As String, EmailSignature As String

Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
Dim ws As Worksheet

CurrentMonth = ""

'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)

If .Show = True Then
DestFolder = .SelectedItems(1)
Else

MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
Exit Sub
End If
End With

'Current month/year stored in H6 (this is a merged cell)
CurrentMonth = ActiveSheet.Range("H1").Value

'Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & ActiveSheet.Name _
& "_" & CurrentMonth & ".pdf"

'Create the PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating

'Create an Outlook object and new mail message
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

'Display email and specify To, Subject, etc
With OutlookMail

.Display
.To = Email_To
.CC = Email_CC
.BCC = Email_BCC
.Subject = ActiveSheet.Name & EmailSubject & CurrentMonth
.Attachments.Add PDFFile
.Body = "Dear Customer," & vbNewLine & vbNewLine & "Please find attached your latest statement." & vbNewLine & vbNewLine & "Kindest Regards" & vbNewLine & vbNewLine & "West Pharmaceutical Services, Inc." & vbNewLine & "www.westpharma.com"

If DisplayEmail = False Then
.Send

End If

End With

For Each ws In ThisWorkbook.Worksheets
ws.Activate
EmailScript
Next
End Sub

Please paste the code provided UNDER the End Sub line of your existing code, NOT inside the procedure you have.

The code you have pasted above does not match to the one you have in the file attached at your first message.

Sub SendAllSheets()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
     ws.Activate
     create_and_email_pdf
Next
End Sub

I updated the red part to call your existing procedure.

To change the DestFolder, remove this part of code:

'Prompt for file destination
With Application.FileDialog(msoFileDialogFolderPicker)

If .Show = True Then
DestFolder = .SelectedItems(1)
Else

MsgBox "You must specify a folder to save the PDF into." & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify Destination Folder"
Exit Sub
End If
End With

Use instead of the code above:

DestFolder = "C:Test Folder" (update to the static path you need)

awesome. thank you so much.

one last question if you don't mind.

How do I code to have the email sent automatically? At the moment it creates the email and I need to press on SEND.

Again thank you so much for your help

Replace:

With OutlookMail

.Display

with:

With OutlookMail

.Send

And remove this part:

If DisplayEmail = False Then
.Send

End If

thank you. I had to make a change to make it work but thank you so much.