Neue Sheets mit KW im Sheetnamen

Forumthread: Neue Sheets mit KW im Sheetnamen
5 Beiträge zu diesem Forumthread
Anzeige
Threads zu ähnlichen Themen

Forumthread: Neue Sheets mit KW im Sheetnamen

18.12.2024 12:17:58

Chris

Hallo zusammen.

ich habe ein Sheet "Muster", dass sich 6x kopieren möchte, der erste Kopie soll als Sheetnamen die aktuelle Kalenderwoche haben, alle weiteren Namen sollen um 1 erhöht werden. Dabei soll berücksichtigt werden, dass bei der letzten KW des aktuellen Jahres die Zählung wieder bei 1 beginnt.

Dazu habe ich mir folgendes Makro gebastelt, dass mir das Sheet Muster kopiert, jedoch erscheint in der Zählung auch die KWs 57,58,59 usw.

Was muss geändert werden?



Sub kw()



For i = 0 To 6

b = WorksheetFunction.WeekNum(DateSerial(Year(Date), Month(Date), 21)) + i

Sheets("Muster").Copy after:=Sheets(1)

ActiveSheet.Name = b

i = i + 1

Next i

       

End Sub

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Neue Sheets mit KW im Sheetnamen

18.12.2024 12:27:43

Oberschlumpf
AW: Neue Sheets mit KW im Sheetnamen

18.12.2024 12:28:53

Onur
Deine Anfrage in ChatGPT:

18.12.2024 13:10:16

MCO
AW: Neue Sheets mit KW im Sheetnamen

18.12.2024 13:24:54

GerdL
AW: Neue Sheets mit KW im Sheetnamen

18.12.2024 13:45:42

Chris

AW: Neue Sheets mit KW im Sheetnamen

18.12.2024 12:27:43

Oberschlumpf

Hi,

hab jetzt deinen Coe nicht getestet, aber....welche Aufgabe hat die Codezeile:

i = i + 1

???

Der Wert für i wird doch schon mit For/Next immer um 1 erhöht, wozu dann extra noch mal i = i + 1 ?

Ciao
Thorsten

AW: Neue Sheets mit KW im Sheetnamen

18.12.2024 12:28:53

Onur

Was soll denn stattdessen erscheinen? Etwa noch ein Blatt mit dem Namen "01" ? Du solltest mal dein Konzept überdenken....

Deine Anfrage in ChatGPT:

18.12.2024 13:10:16

MCO

Du solltest aber noch das Jahr mit einbauen um das von Onur beschriebene Problem zu umgehen

Sub KopiereUndBenennen()

    Dim i As Integer

    Dim aktuelleKW As Integer

    Dim neueKW As Integer

    Dim sheetName As String

    

    ' Aktuelle Kalenderwoche ermitteln

    aktuelleKW = WorksheetFunction.WeekNum(Date, vbMonday)

    

    ' Musterblatt definieren

    Dim musterSheet As Worksheet

    Set musterSheet = ThisWorkbook.Sheets("Muster")

    

    ' 6 Kopien erstellen und benennen

    For i = 0 To 5

        neueKW = (aktuelleKW + i) Mod 52

        If neueKW = 0 Then neueKW = 52

        sheetName = "KW" & neueKW

        

        ' Prüfen, ob ein Blatt mit dem Namen bereits existiert und löschen

        On Error Resume Next

        Application.DisplayAlerts = False

        ThisWorkbook.Sheets(sheetName).Delete

        Application.DisplayAlerts = True

        On Error GoTo 0

        

        ' Blatt kopieren und umbenennen

        musterSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = sheetName

    Next i

    

    MsgBox "Blätter erfolgreich kopiert und benannt."

End Sub

Gruß, MCO

AW: Neue Sheets mit KW im Sheetnamen

18.12.2024 13:24:54

GerdL

Moin Chris,

teste mal.

Sub Unit()



    Dim i As Integer

    

    For i = 0 To 5

        MsgBox WorksheetFunction.WeekNum(Date + 7 * i, 2)

        Sheets("Muster").Copy after:=Sheets(1)

        ActiveSheet.Name = "KW" & Format(WorksheetFunction.WeekNum(Date + 7 * i, 2), "00")

    Next



End Sub

Gruß Gerd