Zweite Leere Zeile löschen

Sub LeereZeilenLoeschen() Dim i As Long Application.ScreenUpdating = False For i = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1 If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete End If If i Mod 100 = 0 Then Application.StatusBar = i End If Next i Application.StatusBar = False Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub MehrfachLeereZeilenLoeschen() Dim i As Long Application.ScreenUpdating = False For i = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1 If Application.WorksheetFunction.CountA(Rows(i - 1)) = 0 And _ Application.WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete End If If i Mod 100 = 0 Then Application.StatusBar = i End If Next i Application.StatusBar = False Application.ScreenUpdating = True End Sub

Sub LeereZeilenLoeschen() Dim i As Long Dim unterste As Long, erste As Long, zweite As Long unterste = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row Application.ScreenUpdating = False zweite = Application.WorksheetFunction.CountA(Rows(unterste)) For i = unterste To 2 Step -1 ' Ende auf 2 geändert erste = Application.WorksheetFunction.CountA(Rows(i - 1)) If erste = 0 And zweite = 0 Then Rows(i).Delete End If If i Mod 100 = 0 Then Application.StatusBar = i End If zweite = erste Next i Application.StatusBar = False Application.ScreenUpdating = True End Sub

Hi
bei echten Leerzeilen und wenn es reicht eine Spalte zu prüfen:
dim Bereich as range

For Each Bereich in Columns(1).SpecialCells(xlcelltypeblanks).Areas
if Bereich.Cells.Count > 1 _
Bereich.Offset(1, 0).Resize(Bereich.Cells.Count -1, 1).EntireRow.Delete
next

ohne VBA gäbs auch noch ne einfache Lösung:
1. schreibe in die erste freie Zeile am Tabellenende in Zeile 2 die Formel:

=Wenn(Oder(A1"";A2"");Zeile();0)

und ziehe die Formel bis ans Tabellenende runter
2. schreibe in die Zeile 1 der Hilfsspalte die Zahl 0
3. wende jetzt auf die ganze Tabelle die Funktioin DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN an, mit der Hilfsspalte als kriterium und und der Option ganze ohne Überschrift
das ganze geht natürlich auch als Makro (hier mit einer Formel, die die ganze zeile auf "leer" prüft:

Sub test()
With ActiveSheet.UsedRange
With .Columns(.Columns.Count + 1)
.Offset(1, 0).Resize(.Rows.Count - 1, 1).FormulaR1C1 = _
"=IF(CountA(R[-1]C1:RC[-1])=0,0,Row())"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zweite Leere Zeile löschen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread