Sub Jede2teZeileLeerzeileEinfuegen()
Const c_ZersteWerteZeile = 5
Const c_MaxZeilenAnzahl = 65535
Dim x As Long, l_Zeilemax As Long, ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = False
l_Zeilemax = ws.UsedRange.Rows.Count
If l_Zeilemax > (c_MaxZeilenAnzahl - 1) / 2 Then
MsgBox ( _
vorhandene Zeilenanzahl & l_Zeilemax & _
* 2 ist größer als max. Zeilenanzahl & c_MaxZeilenAnzahl)
Else
For x = l_Zeilemax To c_ZersteWerteZeile + 1 Step -1
If x Mod 100 Then DoEvents
Application.StatusBar = l_Zeilemax & / & x
ws.Rows(x).Insert Shift:=xlDown
Next
End If
Application.StatusBar =
Application.ScreenUpdating = True
Set ws = Nothing
End Sub
'*****************************************************************
Sub LeereZeilenLoeschen()
Const c_ZersteWerteZeile = 5
Dim x As Long, y As Long, l_Zeilemax As Long, l_SpalteMax As Long
Dim ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = False
l_Zeilemax = ws.UsedRange.Rows.Count
l_SpalteMax = ws.UsedRange.Columns.Count
->On Error Resume Next
For x = l_Zeilemax To c_ZersteWerteZeile Step -1
If x Mod 100 Then DoEvents
Application.StatusBar = l_Zeilemax & / & x
For y = 1 To l_SpalteMax
If Not IsEmpty(ws.Cells(x, y).Value) Then GoTo HatInhalt
Next
ws.Rows(x).Delete
HatInhalt:
Next
Application.StatusBar =
Application.ScreenUpdating = True
Set ws = Nothing
End Sub