Fehler beim Speichern

Sub Copy_Files_with_new_name()
Dim wb                      As Workbook
Dim wbThis                  As Workbook     'workbook where range and path is stored
Dim wbTarget                As Workbook     'workbook from where the data is to be copied from,  _
_
_
_
(aka Overnights file)
Dim Path1                   As String       'path in which the files are which shall be opened
Dim Path2                   As String       'path in which new files shall be safed
Dim NewFileName             As String       'neuer Speichername
Dim SaveNamePeriod          As String       'Save Name Period
Dim fname                   As String
Dim oldFileName             As String
Dim Name_left               As String       'first 5 digits of existing file-name
Dim Name_end                As String       'len of whole existing file-name
With Application
.ScreenUpdating = False
.AutoRecover.Enabled = False
.EnableEvents = False
.DisplayAlerts = False
'.Application.StatusBar = "Zur Zeit wird das Makro ausgeführt"
End With
Set wbThis = ActiveWorkbook                 'set to the current active workbook (the source  _
book, the Master!)
Path1 = sht_makro.Range("Path1").Value                            ' Path wo Files gespeichert    _
_
_
_
sind
Path2 = sht_makro.Range("Path2").Value                            ' Path wo Files gespeichert    _
_
_
_
sind
SaveNamePeriod = sht_makro.Range("B7").Value                         ' Cellname Periode - ( _
currently in cell B7 in File Makro)
'Öffnet die Files des "openPath"
fname = Dir(Path1)
Do While fname  ""
With Application
.AutoRecover.Enabled = False
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set wbTarget = Workbooks.Open(Filename:=Path1 & fname)
oldFileName = wbTarget.Name
Name_left = InStr(oldFileName, "_")
Name_end = InStr(oldFileName, ".")
NewFileName = Mid(oldFileName, Name_left + 1, Name_end - Name_left - 1)
wbTarget.SaveAs Filename:=Path2 & SaveNamePeriod & NewFileName
With Application
.ScreenUpdating = True
.autorecever.Enabled = True
.EnableEvents = True
.DisplayAlerts = True
End With
wbTarget.Close
fname = (Dir)
Loop
'dann wieder zum Makrofile wechseln
wbThis.Activate
With Application
.ScreenUpdating = True
.AutoRecover.engabled = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub