bestehende Tabellenblätter nicht neu datieren

Sub Woche()
Dim i As Integer, dteStart As Date, arrColors
arrColors = Array(35, 43, 50, 36, 6)
dteStart = Sheets("Date").Range("A1")
Application.ScreenUpdating = False
For i = 0 To 4
Sheets("Leerformular " & Format(dteStart + i, "DDD")).Copy _
After:=ThisWorkbook.Sheets(Sheets.Count)
With ActiveSheet
.Range("B1") = dteStart + i
.Tab.ColorIndex = arrColors(i)
.Name = Format(dteStart + i, "DDD DD.MM.YYYY")
End With
Next i
Application.ScreenUpdating = True
End Sub

Das Makro klappt wunderbar bis zur einschließlich 48 Tabelle, dann kommt
das, wenn ich die nächste Woche anlegen will:
Laufzeitfehler 1004:
Die Copy-Methode des Worksheets-Objektes konnte nicht ausgeführt werden.
Im Makro wird folgender Ausdruck gelb hinterlegt:
Sheets("Leerformular " & Format(dteStart + i, "DDD")).Copy _
After:=ThisWorkbook.Sheets(Sheets.Count)
Ich freue mich auf eure Hilfe
Danke und Gruß
Don