sporadischer Fehler beim PDF Druck (1004)

Public Sub Speichern_in_PDF_XLSX()
Dim varPath As Variant
Dim strDir As String
Dim wkb As Workbook, wkbCopy As Workbook, bolSpeichern As Boolean
On Error GoTo Fin
Sheets("Tabelle1").Select
varPath = Application.GetSaveAsFilename( _
InitialFileName:="D:\Dokumente\", _
FileFilter:="Excel(*.xlsx), *.xlsx", _
Title:="Save as XLSX and PDF")
If Not varPath = False Then
strDir = Left(varPath, InStrRev(varPath, "\"))
Set wkb = ActiveWorkbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
If Dir(varPath)  "" Then
Select Case MsgBox("Datei überschreiben?", 4 + 32 + 0, "Datei")
Case vbYes
bolSpeichern = True
Case Else
GoTo Fin
End Select
Else
bolSpeichern = True
End If
If bolSpeichern = True Then
wkb.Sheets("Tabelle1").Copy
Set wkbCopy = ActiveWorkbook
With wkbCopy
wkb.Sheets("Deckblatt").Copy After:=.Sheets(1)
wkb.Sheets("Bearbeiten").Copy After:=.Sheets(2)
.SaveAs varPath, 51
.Close False
End With
Set wkbCopy = Nothing
With wkb
.Worksheets("Tabelle1").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Tabelle1 " & Format(Date, "YYYY-MM") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Worksheets("Deckblatt").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strDir & "Deckblatt " & Format(Date, "YYYY-MM") & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
End With
Set wkb = Nothing
End If
Else
MsgBox "Abgebrochen..."
End If
Fin:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
If Err.Number  0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description
End Sub