运行sub

Question

我正在制作一个日历，并且正在尝试创建一个子库，该子库在相应的月份表中自动填写一年中的每个星期。周格式和内容由

复制

 firstRange.Copy Destination:=secondRange

从隐藏的Excel工作表中，然后使用

输入日期和标题

 Call secondRange.Replace("Sometext", Weekdate)

问题是每次我使用此功能时，我的Excel工作表的大小增加大约4KB。这不是太成问题，因为Sub每年只会使用一次，但是在文件大小显着增加之前我遇到了类似的问题，通常是在使用VBA删除行或列时。

我是否需要更改某些内容，或者只是我需要使用Excel的某些问题？低于完整子（英语和德语的混合）

Public Sub newYear(Optional dasJahr As Integer = 0)

    If dasJahr = 0 Then dasJahr = getYear() ' Nimmt Constant thisYear falls nichts anderes spezifiziert ist. 

    ' Auschalten von Events
    Application.EnableEvents = False

    ' Löschen der Inhalte auf den Monatsblättern
    Worksheets("Januar").Cells.ClearContents
    Worksheets("Februar").Cells.ClearContents
    Worksheets("März").Cells.ClearContents
    Worksheets("April").Cells.ClearContents
    Worksheets("Mai").Cells.ClearContents
    Worksheets("Juni").Cells.ClearContents
    Worksheets("Juli").Cells.ClearContents
    Worksheets("August").Cells.ClearContents
    Worksheets("September").Cells.ClearContents
    Worksheets("Oktober").Cells.ClearContents
    Worksheets("November").Cells.ClearContents
    Worksheets("Dezember").Cells.ClearContents

    Dim Montag As Date
    Dim Neujahr As Date: Neujahr = DateValue("1.1." & dasJahr)

    Dim hoeheWoche As Integer: hoeheWoche = 69
    Dim breiteWoche As Integer: breiteWoche = 35

    Dim wsMnt As Worksheet: Set wsMnt = Worksheets("Januar")
    Dim wsVrlg As Worksheet: Set wsVrlg = Worksheets("Vorlage")

    Dim rDst As Range, rSrc As Range
    ' Kopiervorlage als Source definieren
    Set rSrc = wsVrlg.Range(wsVrlg.Cells(1, 1), wsVrlg.Cells(hoeheWoche + 1, breiteWoche + 1))


    Montag = Neujahr - Weekday(Neujahr, vbTuesday)

    Dim wochenStartReihe As Integer: wochenStartReihe = 2

    Do While (Year(Montag) <= dasJahr)

        If getMonth(Montag - 1, dasJahr) <> getMonth(Montag, dasJahr) Then
            wochenStartReihe = 2
            Set wsMnt = Worksheets(getMonth(Montag, dasJahr))
        End If

        Set rDst = wsMnt.Range(wsMnt.Cells(wochenStartReihe, 2), wsMnt.Cells(wochenStartReihe + hoeheWoche, 2 + breiteWoche))

        ' Kopiert Inhalte und Format aus der Vorlage in das Monatsblatt
        rSrc.Copy Destination:=rDst

        ' Ersetzen der Wochentage mit Datum
        Call rDst.Replace("Woche X ausblenden", "Woche " & KWoche(Montag) & " ausblenden")
        Call rDst.Replace("Montag", Montag)
        Call rDst.Replace("Dienstag", Montag + 1)
        Call rDst.Replace("Mittwoch", Montag + 2)
        Call rDst.Replace("Donnerstag", Montag + 3)
        Call rDst.Replace("Freitag", Montag + 4)
        Call rDst.Replace("Samstag", Montag + 5)
        Call rDst.Replace("Sonntag", Montag + 6)

        ' Doppelte Auflistung der Wochen die in zwei Monaten liegen
        If (getMonth(Montag, dasJahr) <> getMonth(Montag + 6, dasJahr)) And (getMonth(Montag + 6, dasJahr) <> "Januar") Then

            Set wsMnt = Worksheets(getMonth(Montag + 6, dasJahr))
            wochenStartReihe = 2

            Set rDst = wsMnt.Range(wsMnt.Cells(wochenStartReihe, 2), wsMnt.Cells(wochenStartReihe + hoeheWoche, 2 + breiteWoche))

            rSrc.Copy Destination:=rDst

            Call rDst.Replace("Woche X ausblenden", "Woche " & KWoche(Montag) & " ausblenden")
            Call rDst.Replace("Montag", Montag)
            Call rDst.Replace("Dienstag", Montag + 1)
            Call rDst.Replace("Mittwoch", Montag + 2)
            Call rDst.Replace("Donnerstag", Montag + 3)
            Call rDst.Replace("Freitag", Montag + 4)
            Call rDst.Replace("Samstag", Montag + 5)
            Call rDst.Replace("Sonntag", Montag + 6)

        End If

        wochenStartReihe = wochenStartReihe + hoeheWoche + 3
        Montag = Montag + 7

    Loop

    ' Events wieder einschalten
    Application.EnableEvents = True

End Sub