save multiple worksheets as PDF

Hi,

I have a code set up to save a worksheet as a pdf and open in outlook but i was hoping to adapt it to attach several work sheet within the same work book as a single PDF. The Work sheets will be the active one and the following 3 to the right. There are other worksheets at the beginning of the work book which i dont want attached. The Current code i have is

Sub Saveaspdfandsend()
Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xUsedRng As Range
Dim xPath As String

Set xSht = ActiveSheet
xPath = Range("k14") 'here "workshet to pdf" is the destination folder to save the pdf files
   
xFolder = xPath & "\" & xSht.Range("k17").Value
If Len(Dir(xFolder & ".pdf")) > 0 Then
xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", _
vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
Kill xFolder & ".pdf"
Else
        MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
        Exit Sub
    End If
    If Err.Number <> 0 Then
        MsgBox "Unable to delete existing file.  Please make sure the file is not open or write protected." _
                    & vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
        Exit Sub
    End If
End If
 
Set xUsedRng = xSht.UsedRange
If Application.CountA(xUsedRng.Cells) <> 0 Then
    'Save as PDF file
 
xSht.ExportAsFixedFormat 0, xFolder
    
    
    'Create Outlook email
With CreateObject("Outlook.Application").CreateItem(0)
        .Display
        .To = ""
        .CC = ""
        .Subject = "Invoice for Payment " & xSht.Range("k22").Value
        .htmlBody = "Hi," & "<br>" & "<br>" & "Please find attached our invoice for payment " & Range("k22").Value & "<br>" & "<br>"
        .Attachments.Add xFolder & ".pdf"
        If DisplayEmail = False Then
            '.Send
        End If
    End With
Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
End If
End Sub

Any help would much be appreciated.

Thanks

Danny

Change this

xSht.ExportAsFixedFormat 0, xFolder

to this

    x = xSht.Index
    Sheets(Array(xSht.Name, Sheets(x + 1).Name, Sheets(x + 2).Name, Sheets(x + 3).Name)).Select False
    ActiveSheet.ExportAsFixedFormat 0, xFolder
    Sheets(x).Select

You're welcome and thanks for rep+.

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED.