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