Makro erweitern - Null Zeilen löschen
17.09.2007 11:17:20
Matze
Ich habe ein Makro, bei dem nur ein Part modifiziert werden muss. Und zwar wird im Bereich L bis BR jede Zeile gelöscht die nur 0-Werte hat. Soweit so gut.
Nun ist aber Folgendes. Ab (in) Zeile 26 wird jeweils ein Quotient gebildet bis zur Zeile 233 (dort wird jeweils das Ergebnis ausgewiesen). In den beiden Folgezeilen stehen die Basiswerte zur Bildung.
Das Makro soll nun die Zeilen der Quotientenbildung (also 26, 29... 233) checken und sobald da das Ergebnis = 0 ist, soll diese Zeile sowie die beiden Zeilen mit den Basiswerten gelöscht werden (immer die beiden folgenden Zeilen).
Anbei das derzeitige Makro. Wie gesagt, es geht nur um diesen kleinen Part, wo ich eine Anpassung benötige. Vielen Dank für eure Hilfe.
Sub Wertkopie2()
Dim i As Long, lastRow As Long
Dim saveName As String
ActiveSheet.Copy
With ActiveSheet
.Unprotect ("xxx")
.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 = lastRow To 24 Step -1
If Application.WorksheetFunction.Sum(Range("L" & i & ":BR" & i)) = 0 Then
Rows(i).Delete
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