Problem: Arbeitsspeicher, Laufzeitfehler 1004

folgender Code produziert bei mir die meldung nicht genügend arbeitsspeicher - bzw Laufzeitfehler 1004 immer beim 17 durchlauf an der Stelle activesheet.paste(er wird von durchlauf zu durchlauf langsamer)
ein paar variablen brauche ich später in dem code - habe ich allerdings zu testzwecken ausgeschaltet
wenn ich activesheet.paste auskommentiere läuft der code durch
kann mir jemand helfen?
Option Explicit
Public Sub fzzählen()
Dim Postenliste As String
Dim AWtabelle As String
Dim i As Integer
Dim Anzi As Integer
Dim k As Integer
Dim Anzk As Integer
Dim Beschafft As Date
Dim l As Integer
Dim Start As Integer
Dim Rangej As Range
Dim Rangeq As Range
Dim Zelle As Long
Sheets("index").Select
i = "2"
Anzi = Application.WorksheetFunction.CountA(Columns("D"))
For i = "2" To Anzi
Sheets("index").Select
Postenliste = Cells(i, "D")
AWtabelle = Cells(i, "E")

Sheets(Postenliste).Select
Set Rangej = Range("J:J")
Set Rangeq = Range("Q:Q")

Rangej.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Rangeq.Select

Selection.Copy

Sheets(AWtabelle).Select
Cells("1", "Z").Select

ActiveSheet.Paste 'FEHLER beim 17 Durchlauf

Sheets(Postenliste).Select
ActiveSheet.ShowAllData

Set Rangej = Nothing
Set Rangeq = Nothing

Next i
goto ende

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Webmav,
möglicherweise wird Dein Clipboard nicht geleert und Du hast nach 16 Durchläufen jede Menge Daten im Speicher. Keine Ahnung. Ich hätte 2 Vorschläge zu diesem Problem.
1. Du erweiterst den virtuellen Speicher in der Systemsteuerung.
2. über ein Array
(ist noch nicht optimiert, dauert in der Abarbeitung länger als bisher, ist noch nicht an Deine Anwendung angepaßt [kann ich Dir jetzt nicht machen, will noch weg zu einer Fete, aber anpassen kannst Du hoffentlich allein] und muß mit in die Schleife eingebunden werden.)
Das sähe dann in etwa so aus:
Option Explicit


Sub Nur_Spezialfilterzellen_berücksichtigen()
Dim aInhalt(), lz#, x#, wert, iAnz#
Sheets("Tabelle1").Select
Erase aInhalt()
lz = UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
Range("E1:E" & lz).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Range("E1:E" & lz).Cells.SpecialCells(xlCellTypeVisible).Select
iAnz = Selection.Cells.Count
For Each wert In Selection
ReDim Preserve aInhalt(x)
aInhalt(x) = wert
x = x + 1
Next
ActiveSheet.ShowAllData
For x = 0 To iAnz - 1
Sheets("Tabelle2").Range("F" & x + 1) = aInhalt(x)
Next x
End Sub

Ciao, Ralf

Beliebteste Forumthreads (12 Monate)

Problem: Arbeitsspeicher, Laufzeitfehler 1004

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread