Sub Saveaspdf()
Dim xSht As Worksheet
Dim xFolder As String
Dim xYesorNo As Integer
Dim xUsedRng As Range
Dim xName As String
For Each xSht In ActiveWorkbook.Worksheets
Select Case LCase(xSht.Name)
Case "plan", "raw data", "plan kpi" 'Define here the sheets to be excluded
GoTo NextSheet
Case Else
xName = xSht.Name
End Select
xFolder = Environ("USERPROFILE") & "\Desktop\Branch PDFs"
xFolder = xFolder + "\" + xSht.Name + ".pdf"
'Check if file already exist
If Len(Dir(xFolder)) > 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
Else
MsgBox "Proceeding with Next Sheet."
GoTo NextSheet
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 & "Proceeding with Next Sheet.", vbCritical, "Unable to Delete File"
GoTo NextSheet
End If
End If
Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, Filename:=xFolder, Quality:=xlQualityStandard
Else
MsgBox "Sheet " & xSht.Name & "is blank"
End If
NextSheet:
Next xSht
MsgBox "Completed"
End Sub