Guten Morgen VBA Profis,

ich hoffe Ihr seid schon fit.
Mit meiner Datei/Makro produziere ich eine Endlos Schleife. Natürlich kommt dann die Meldung "Nicht genügend Arbeitsspeicher....".
Ich finde aber keinen Fehler. Wo liegt das Problem?

https://www.herber.de/bbs/user/170617.xlsm


Sub oez_uebersicht1()

Dim ws As Worksheet
Dim i As Integer
Dim z As Integer
Dim anztbl As Integer
Dim tbl As Integer

i = 3
z = 4
tbl = 1
anztbl = ThisWorkbook.Sheets.Count

For Each ws In Worksheets

If tbl >= anztbl Then Exit For

If ws.Name > "URL" And _
ws.Name > "START" And _
ws.Name > "OEZ_UEBERSICHT" And _
ws.Name > "URL_KOMMUNE" Then


Cells(i, "B") = ws.Name


Sheets(ws.Name).Select

Range("Table_Query__" & ws.Name & "[[#Headers],[Tag]]").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Sheets("OEZ_Uebersicht").Select
Range("B" & z).Select
ActiveSheet.Paste

i = i + 8
z = z + 8
tbl = tbl + 1

End If

Application.CutCopyMode = False

Next

End Sub


Grüße
Günther