bestand vergroot door kopieren van een werkblad

[ikselle]

Eerst graag de beste wensen voor 2016 !!!
Zoals elk jaar maak ik gebruik van een exelbestand om uurprestaties bij te houden. Dit bestaat initieel voornamelijk uit een 53-tal identieke werkbladen (voor iedere week een). Dus wil ik via vba het originele werkblad 52 keer vermenigvuldigen en ondertussen de weekdatums en links van de ene naar de andere week aanpassen. Dit lukt me maar wat blijkt : het ingevulde bestand van 2015 is 28Mb groot en mijn nieuw aangemaakt bestand is 10 keer zo groot. Heb reeds op fora gezocht en het volgende toegepast :
- ctr-end in elk werkblad om te zien of er geen onnodige ruimte gecreeerd is
- sharing nagekeken ; is niet van toepassing
Ik voeg hierbij de door mij gebruikte VBAcode. Heeft iemand een idee wat hiermee mis is ?
Alvast bedankt !!

Sub Vermenigvuldig()
'zorg dat je deze macro uitvoert vanuit je modelsheet
    Dim dEersteWeekdag As Date
    Dim i As Integer
'hier eerst datum (Amerikaans formaat) van eerste
'werkdag uit invulsheet invullen
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    dEersteWeekdag = DateValue(#1/19/2015#)  'datum van maandag op blad dat gekopieerd wordt
    For i = 5 To 56  'i moet beginnen vanaf het nummer van het eerst gecreeerde werkblad
        dEersteWeekdag = DateAdd("ww", 1, dEersteWeekdag)
        'kopieer range vanuit actuele sheet naar klembord
        Range("A1:ad39").Select
        Selection.Copy
        'voer blad achteraan in en wijzig naam
        With Sheets.Add(after:=Sheets(Sheets.Count))
            .Name = Format(i, "00")
        End With
        'voer range uit klembord in
        ActiveSheet.Paste
        ActiveSheet.Range("A1").Select
        'voer links met vorig sheet in
        Range("AA5:AA33").FormulaR1C1 = "='" & Format(i - 1, "00") & "'!RC[1]"
        ' pas datum aan
        Range("D2").Value = dEersteWeekdag
        Columns("A:A").EntireColumn.AutoFit
        Columns("B:H").Select
        Selection.ColumnWidth = 8
        Columns("I:O").Select
        Selection.ColumnWidth = 8
        Columns("P:V").Select
        Selection.ColumnWidth = 6
        Columns("W:AB").Select
        Selection.ColumnWidth = 8
        Columns("AD:AD").Select
        Range("b4").Select
    Next i
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

 

[HSV]

Misschien dat hiermee de grootte afneemt.

Selecteer eens de rij onder de laatst gevulde cel.
Druk Ctrl+Shift+pijltje naar beneden, en druk Delete.
Doe dit bij elk blad en sla het op.

 

[popipipo]

Voorwaardelijke opmaak kan ook nog wel eens een boosdoener zijn.
Zeker als je bereiken gaat kopiëren en plakken.

 

[ikselle]

Bedankt Harry maar haalt spijtig genoeg niets uit.
Popipipo; er is inderdaad opmaak en bereik mee gekopieerd.
Bestaat de oplossing dan uit verwijderen van bereik en opmaak en dit 52 keer aanpassen ? Er moet toch een andere oplossing zijn. Niet ?
Bedankt voor het meedenken.