Code Snippet "VBA Excel"

In markiertem Zellbereich Leerzeilen suchen und löschen

'Dieser Makro sucht in markiertem Zellbereich die Leerzeilen und löscht sie
Sub LeereZeilenInAuswahlLoeschen()
  Dim objAuswahl As Range
  Dim objAuswahlalt As Range
  Dim objLeereZellen As Range
  Dim objRow As Range
  Dim objTemp As Range
  Dim colleft, collright, rowtop, rowbottom
  
  'Nötig, um die Auswahl wieder wie am Anfang setzen zu können
  Set objAuswahlalt = Selection
  Set objAuswahl = Selection
  
  'Die zwei Bereiche müssen gleich breit sein
  'SpecialCells(xlCellTypeBlanks) nimmt immer nur Zellen im Used Range, nicht alle Zellen
  colleft = objAuswahl.Parent.UsedRange.Column
  collright = objAuswahl.Parent.UsedRange.Columns( _
    objAuswahl.Parent.UsedRange.Columns.Count).Column
  rowtop = objAuswahl.Row
  rowbottom = objAuswahl.Rows(objAuswahl.Rows.Count).Row
  Set objAuswahl = Range(Cells(rowtop, colleft), Cells(rowbottom, collright))
  Set objLeereZellen = ActiveSheet.Cells.SpecialCells(xlCellTypeBlanks)
  
  
  For Each objRow In objAuswahl.Rows
    'Es werden nur Zeilen gelöscht, wenn die ganze Zeile leer ist
    Set objTemp = Application.Intersect(objRow.EntireRow.Cells, objLeereZellen)
    'Wenn alle Zellen ausgefüllt sind, dann gibt es keine Überschneidung
    If Not objTemp Is Nothing Then
      If objTemp.Cells.Count = objRow.Cells.Count Then
        Debug.Print "Zeile " & objRow.Row & " wird gelöscht"
        objRow.EntireRow.Delete shift:=xlUp
        Debug.Print Selection.Address & " objAuswahl: " & objAuswahl.Address
      End If
    End If
  Next
  objAuswahlalt.Select
End Sub