Sub BlattKopieren()
Dim i As Integer
For i = 1 To 52
Sheets(1).Copy after:=Worksheets(Worksheets.Count)
Next
End Sub
Sub BlattKopieren()
Dim i As Integer
For i = 1 To 52
Sheets(1).Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "KW " & i
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Übersicht"
For i = 3 To Sheets.Count
Cells(i - 2, 1) = Sheets(i).Name
Next
End Sub
Sub BlattKopieren()
Dim i As Integer
Dim dAnfang
dAnfang = InputBox("Anfangsdatum eingeben", "START")
If dAnfang = "" Or Not IsDate(dAnfang) Then
MsgBox "kein gültiges Datum"
Exit Sub
End If
For i = 1 To 3
Sheets(1).Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = CDate(dAnfang) & " - " & CDate(dAnfang) + 5
dAnfang = CDate(dAnfang) + 7
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Übersicht"
For i = 3 To Sheets.Count
Cells(i, 1) = Sheets(i).Name
Next
End Sub
Sub BlattKopieren5()
Dim i As Integer
Dim dAnfang
dAnfang = InputBox("Anfangsdatum eingeben", "START")
If dAnfang = "" Or Not IsDate(dAnfang) Then
MsgBox "kein gültiges Datum"
Exit Sub
End If
For i = 1 To 52
Sheets(1).Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = CDate(dAnfang) & " - " & CDate(dAnfang) + 5
dAnfang = CDate(dAnfang) + 7
Next
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Übersicht"
For i = 3 To Sheets.Count
Cells(i, 1) = Sheets(i).Name
Next
End Sub
Die Datei https://www.herber.de/bbs/user/15202.xls wurde aus Datenschutzgründen gelöscht
Wenn Du Dir die noch mal anschauen könntest wäre, das echt nett.