Doppelte Schleife

Hallo Zusammen,
evtl. könnt ihr mir bei einem Problem helfen.
Ich habe eine Arbeitsmappe, bei der alle Blätter gleich aufgebaut sind, bei denen ich folgenden Befehl als Schleife innerhalb des Blattes ausführen will:

Sub Nicht_benutzte_GS()
Dim I As Long
For I = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(I, 1)  Range("B1") Then Rows(I).Delete
Next I
End Sub

Die o.g. Befehle funktionieren auch jeweils in den Blättern. In Spalte A steht u.a. der angesprochene Name, der durch B1 definiert wird. Alle Zeilen mit anderen Namen in A sollen gelöscht werden.
Jetzt soll o.g. Befehl jeweils in allen Blättern, bis auf das erste in der Arbeitsmappe ausgeführt werden.
Folgendes habe ich versucht:

Sub WorksheetLoop()
Dim WS_Count As Integer
Dim i As Integer
Dim r As Integer
WS_Count = ActiveWorkbook.Worksheets.Count
For r = 1 To WS_Count
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(i, 1)  Range("B1") Then Rows(i).Delete
Next i
Next r
End Sub

Leider führt er den Befehl zwar auf dem ersten Blatt aus, jedoch nicht auf allen Blättern. Es scheint, als würde das "Next r" nicht angesprochen werden. Habt ihr eine Idee, wie man die beiden Befehle kombinieren kann?
Ich freu mich über eure Hilfe
Nico

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub WorksheetLoop() Dim WS_Count As Integer Dim i As Integer Dim r As Integer WS_Count = ActiveWorkbook.Worksheets.Count For r = 1 To WS_Count With ActiveWorkbook.Worksheets(i) For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 1 Step -1 If .Cells(i, 1) .Range("B1") Then .Rows(i).Delete Next i end with Next r End Sub

Sub Header() Dim WS_Count As Integer Dim i As Integer Dim r As Integer Worksheets("Testblatt").Select WS_Count = ActiveWorkbook.Worksheets.Count For r = 1 To WS_Count With ActiveWorkbook.Worksheets(r) Application.CutCopyMode = False Rows("1:12").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").FormulaR1C1 = "LUCANET" Range("A3").FormulaR1C1 = "Name" Range("A4").FormulaR1C1 = "Buchungskreis" Range("A5").FormulaR1C1 = "Datenebene" Range("A6").FormulaR1C1 = "Bewertungsebene" Next r End Sub

Sub Header() Dim WS_Count As Integer Dim i As Integer Dim r As Integer Worksheets("Testblatt").Select WS_Count = ActiveWorkbook.Worksheets.Count For r = 1 To WS_Count With ActiveWorkbook.Worksheets(r) Application.CutCopyMode = False .Rows("1:12").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove .Range("A1").FormulaR1C1 = "LUCANET" .Range("A3").FormulaR1C1 = "Name" .Range("A4").FormulaR1C1 = "Buchungskreis" .Range("A5").FormulaR1C1 = "Datenebene" .Range("A6").FormulaR1C1 = "Bewertungsebene" end with Next r End Sub

Sub test() Dim sh As Worksheet Dim Zelle As Range For Each sh In ActiveWorkbook.Worksheets Set Zelle = sh.Columns(1).Find(what:=sh.Range("B1").Value, lookat:=xlWhole) If Not Zelle Is Nothing Then Zelle.EntireColumn.ColumnDifferences(Zelle).EntireRow.Delete Next End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread