A única razão pela qual você está tendo que escolher uma pasta é esta parte ..
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)
If xFileDlg.Show = True Then xFolder = xFileDlg.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
Isso é ótimo se você quiser escolher a pasta toda vez ou precisar criar uma nova pasta. Mas se a pasta existir e você sempre for salvá-la no mesmo local, tire a parte acima e adicione manualmente o local da pasta.
Exemplo:
xFolder="C: \ MyPDFs" + "\" + xSht.Name + Format (Agora, "aaaa-mm-dd hmmAM / PM") + ".pdf"