Excel klembord vol bij run macro

[geertsjelle]

Hallo allemaal,

Ik heb een macro in Excel die een aantal (tussen de 40 en 150) nieuwe werkbladen aanmaakt. Dit gebeurt door het kopieeren van een bestaand werkblad.
Helaas loop de macro steeds vast als er ca 26 bladen gekopieerd zijn. Vervolgens krijg ik de onderstaande foutmelding in excel (zie rode markering). Met de melding Fout 1004 tijdens uitvoering. En Methode Copy van klasse Worksheet is mislukt.

Weet iemand hoe ik dit kan oplossen?

ub selecteren()
    Sheets("Resultaat").Select
    aantalrapporten = Range("e1").Value
    For I = 1 To aantalrapporten
        Range("b2") = I
        If I <> 1 Then
  [COLOR="red"]Sheets("rapport").Copy Before:=Sheets("Toelichting")[/COLOR]
        End If
        Sheets("Resultaat").Select
        Range("b2") = I
        j = 0
        For j = 0 To 1
        Range("a2") = j
            If j = 0 Then
                Range("A7:M6000").AdvancedFilter Action:=xlFilterCopy, _
                    CriteriaRange:=Range("A1:B2"), CopyToRange:=Range( _
                    "AA1:AM1"), Unique:=False
            Else
                Range("A7:M6000").AdvancedFilter Action:=xlFilterCopy, _
                    CriteriaRange:=Range("A1:B2"), CopyToRange:=Range( _
                    "AA40:AM40"), Unique:=False
            End If
        Next j
        Range("AA1:AM1000").Select
        Selection.Copy
        If I = 1 Then
            Sheets("rapport").Select
        Else
            Sheets("rapport (" & I & ")").Select
        End If
        Range("P3").Select
        ActiveSheet.Paste
        Range("A1").Select
        Range("P1") = I
        Sheets("Resultaat").Select
    Next I
    Sheets("Resultaat").Select
    Range("A1").Select
End Sub

 

[E v R]

Wellicht kun je het ondervangen door steeds jouw klembord leeg te maken na een plak-aktie met: Application.CutCopyMode = False

Deze application.cutcopymode = false heb ik in jouw code een paar keer toegevoegd en een en ander wat herschreven, werkt het nu wel?

Sub selecteren()
    Dim aantalrapporten As Long, i As Long, j As Long
    
    With Application
        .ScreenUpdating = False
    End With

    With Sheets("Resultaat")
        aantalrapporten = .Range("e1").Value
        For i = 1 To aantalrapporten
            .Range("b2") = i
            If i <> 1 Then Sheets("rapport").Copy Before:=Sheets("Toelichting")
            Application.CutCopyMode = False
            j = 0
            For j = 0 To 1
                .Range("a2") = j
                If j = 0 Then
                    .Range("A7:M6000").AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=.Range("A1:B2"), _
                        CopyToRange:=.Range("AA1:AM1"), Unique:=False
                Else
                    .Range("A7:M6000").AdvancedFilter Action:=xlFilterCopy, _
                        CriteriaRange:=Range("A1:B2"), _
                        CopyToRange:=.Range("AA40:AM40"), Unique:=False
                End If
            Next j
            .Range("AA1:AM1000").Copy
            If i = 1 Then
                With Sheets("rapport")
                    .Range("P3").PasteSpecial
                    .Range("P1") = i
                    Application.CutCopyMode = False
                    .Select
                    .Range("a1").Select
                End With
            Else
                With Sheets("rapport (" & i & ")")
                    .Range("P3").PasteSpecial
                    .Range("P1") = i
                    Application.CutCopyMode = False
                    .Select
                    .Range("a1").Select
                End With
            End If
        Next i
        .Select
        .Range("a1").Select
    End With
    With Application
        .ScreenUpdating = True
    End With

End Sub

 

[geertsjelle]

Eric,

Bedankt voor je reactie!

Het werkt helaas nog steeds niet.
Ik twijfel nu ook een beetje of het wel het klembord is.

Als ik de macro run begint excel werkbladen aan te maken tot de error verschijnt. Als ik daarna handmatig het klembord wis en ik run de macro, dan loopt deze gelijk weer vast. Sluit ik het document en open ik hem weer dan maakt de macro weer een aantal bladen aan tot deze vast loopt.

Het lijkt er op of er een ander geheugen vol zit dan het klembord geheugen (als er dat is)?

 

[Wigi]

Ik heb in de code een hoop ballast overboord gegooid, ook wetende dat ik geen voorbeeldbestand ter beschikking heb. Dit gaat 99 kansen op 100 niet werken van de eerste keer, maar het geeft wel een goede aanzet volgens mij om op verder te werken.

Sub selecteren()
    Sheets("Resultaat").Select
    For I = 1 To [E1]
        If I > 1 Then Sheets("rapport").Copy Before:=Sheets("Toelichting")
        Sheets("Resultaat").Select
        Range("A7:M6000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("AA1:AM1"), Unique:=False
        Range("A7:M6000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A1:B2"), CopyToRange:=Range("AA40:AM40"), Unique:=False
        Range("AA1:AM1000").Copy Sheets(IIf(I = 1, "rapport", "rapport (" & I & ")")).Range("P3")
    Next
    Range("A1").Select
End Sub

Wigi

 

[geertsjelle]

Wigi,

Bedankt voor je reactie en je code.

De code loopt inderdaad nog vast.
Maar in elk geval bedankt voor niet nieuwe aanzet.

--------------

Jelle

 

[E v R]

Jelle,

Plaats eens een (voorbeeld)bestandje waarin eea niet werkt, staat er nog andere code in?

 

[geertsjelle]

Hoi Eric,

Ik kan komende week pas weer bij het bestand (vergeten mee te nemen). Ik heb het proberen na te bouwen maar aan gezien het een vrij complex bestand is is het me niet gelukt

Ik zit zelf te denken aan een export-import functie ipv een kopieer functie.

--------------------------

Jelle