Neue Datei im selben Ordner

Sub cp_wbk()
Dim wbk_neu As Workbook
Dim wbk_alt As Workbook
Dim MyFileName As String
Dim MyPfad As String
Dim MyShape As Shape
Set wbk_alt = ActiveWorkbook
Set wbk_neu = Workbooks.Add
wbk_alt.Activate
MyPfad = "T:\Qs\Innenkontrolle\Heinz & Co\Test\Test.Stunden\" 'anpassen
MyFileName = "Stundenliste - " & Range("B3") & " " & _
Month(Range("A6")) & " " & Year(Range("A6"))
wbk_alt.Sheets(1).Copy before:=wbk_neu.Sheets(1)
For Each MyShape In wbk_neu.Sheets(1).Shapes
If MyShape.AlternativeText  "Neues Monat anlegen" Then MyShape.Delete
Next
wbk_neu.SaveAs MyPfad & MyFileName
wbk_neu.Close
'MsgBox "Sicherung siehe: " & MyPfad & MyFileName
End Sub

Sub WochenendeWeg()
If MsgBox("Wollen Sie ein neues Monat erstellen ?", vbQuestion + vbYesNo, _
" Nachfrage Neues Monat erstellen !") = vbNo Then Exit Sub
Call cp_wbk
'-------Monat um 1 Hochzählen----------
'In G1 steht jetzt eine Formel, die nicht mehr geändert werden muss,
'daher wird nur noch F1 geändert.
Range("F1") = DateAdd("m", 1, Range("F1"))
'Blattname neu bestimmen
ActiveSheet.Name = Range("G1")
Dim datStart As Date, datEnd As Date
Dim lDay As Long
Dim iRow As Integer
datStart = Range("F1").Value ' in der Zelle M3 befindet sich das Anfangsdatum
datEnd = Range("H1").Value   ' in der Zelle H1 befindet sich das Enddatum
iRow = 6 ' Hiermit wird gesagt, dass in Zeile 6 angefangen werden soll
'Bevor die Daten des neuen Monats eingetragen werden, alte Daten löschen.
'Anschließend Zahlenformate in den Spalten A und B wiederherstellen
'Range("A" & iRow & ":A100").EntireRow.Delete
Range("A6:A39").EntireRow.ClearContents ' Franz Zeile geändert. Statt löschen der Zeilen  _
werden nur Inhalte gelöscht
Range("A6:A39").EntireRow.Interior.ColorIndex = xlColorIndexNone 'Franz entfernt Farbe aus    _
_
_
_
Zellbereich
Range("A6:A39").NumberFormatLocal = "TT.MM.JJJJ"
Range("B6:B39").NumberFormatLocal = "TTT"
For lDay = datStart To datEnd
Select Case WeekDay(lDay, 2)
Case Is  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description
End Sub