Wenn ich die Kalenderwoche in meiner Tabelle abändere, werden zwei neue Blätter erstellt. 

Daraufhin werden Inhalt und Format kopiert und in die Blätter eingefügt und dann eben noch die Druckbereiche so festgelegt wie in der Originaldatei.

Hab hier mal jetzt noch den restlichen Code eingefügt um das ganze ein bisschen anschaulicher zu machen.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Intersect(Target, Cells(4, 72)) Is Nothing Then Exit Sub
    neueKW

End Sub

Sub neueKW()

'Variablendeklaration

    Dim abc As Worksheet
    Set abc= ThisWorkbook.Worksheets("abc")
    
    Dim def As Worksheet
    Set def = ThisWorkbook.Worksheets("def")

    Application.ScreenUpdating = False

'Hier werden die beiden Tabellenblätter für abc und def erstellt
    ThisWorkbook.Worksheets.Add.Name = "KW " & Cells(4, 72) & " abc"
    ThisWorkbook.Worksheets.Add.Name = "KW " & Cells(4, 72) & " def"
    
    Dim abcNeu As Worksheet
    Set abcNeu = Worksheets("KW " & Cells(4, 72) & " abc")
    
    Dim defNeu As Worksheet
    Set defNeu = Worksheets("KW " & Cells(4, 72) & " def")

'Hier werden die beiden Tabellenblätter nach hinten geschoben um ganz hinten zu stehen
    abcNeu.Move After:=Sheets(8)
    defNeu.Move After:=Sheets(8)
    
'Hier wird der Inhalt des Tabellenblatts "abc" kopiert
    With abc
        .Range(.Cells(1, 1), .Cells(1048576, 16384)).Copy
    End With

'Hier wird der Inhalt dann in das neue Tabellenblatt eingefügt (abcNeu)
    With abcNeu
        .Cells(1, 1).PasteSpecial Paste:=xlValues
        .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
    End With
    copyPageSetup abc, abcNeu

'Hier wird der Inhalt des Tabellenblatts "def" kopiert
    With def
        .Range(.Cells(1, 1), .Cells(1048576, 16384)).Copy
    End With

'Hier wird der Inhalt dann in das neue Tabellenblatt eingefügt (def)
    With defNeu
        .Cells(1, 1).PasteSpecial Paste:=xlValues
        .Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
    End With
    copyPageSetup def, defNeu
    
'Hier werden nur die 0-Zellen deaktiviert
    ActiveWindow.DisplayZeros = False

'Hier wird die Bildschirmaktualisierung wieder aktiviert
    Application.ScreenUpdating = True

'Hier werden bis zum Ende der Sub nur noch die jeweiligen Zellen ausgewählt um direkt mit Eintragungen beginnen zu können.
    ActiveSheet.Cells(7, 75).Select
    
    With abcNEu
        .Select
        .Cells(7, 75).Select
    End With


End Sub