Zeilen löschen
17.09.2007 15:51:00
Matze
Komme einfach nicht weiter! Ab Zeile 26 soll das Makro checken, ob in der Zeile im Bereich (L bis BT) 0-Werte in der Zeile sind. Ist dies der Fall wird die Zeile gelöscht und die beiden Folgenden auch. Dann wird weiter geprüft. Leider habe ich quasi eine Endlosschleife, da irgendwann ja nur noch leere Zeilen kommen.
Die letzte Zeile lasse ich verringern um 3, wenn ein Datensatz gelöscht wurde. Nur irgendwie muss ich ja noch definieren wann Ende ist und er weitermacht mit dem speichern. Begreife ich nicht. Habt ihr 'ne Idee?
DANKE!
Sub Wertkopie2()
Dim i As Long, lastRow As Long
Dim saveName As String
ActiveSheet.Copy
With ActiveSheet
.Unprotect ("XX")
.Cells.Select
With Selection
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
.Cells(1, 1).Select
End With
lastRow = ActiveSheet.Range("L" & Rows.Count).End(xlUp).Row
For i = 26 To lastRow Step 1
If Application.WorksheetFunction.Sum(Range("L" & i & ":BT" & i)) = 0 Then
Rows(i).Delete
Rows(i).Delete
Rows(i).Delete
i = i - 1
lastRow = lastRow - 3
End If
Next i
saveName = Application.GetSaveAsFilename(fileFilter:="EXCEL Files (*.xls), *.xls")
Debug.Print saveName
If StrPtr(saveName) 0 Then
ActiveWorkbook.SaveAs saveName
Else
MsgBox "Datei wird nicht gespeichert"
End If
End Sub