mit Sicherheit...
27.01.2009 18:15:08
Tino
Hallo,
eine Abfrage muss noch rein,
damit es nicht zum Fehler kommt, sollte keine Zelle diese Bedingung erfüllen.
Sub Wenn_Ohne_Ueberschrift()
Dim Bereich As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
With ThisWorkbook.Sheets("Tabelle1")
Set Bereich = .Range("K1", .Cells(Rows.Count, 11).End(xlUp))
Set Bereich = Bereich.Offset(0, .Columns.Count - Bereich.Column)
Bereich.FormulaR1C1 = "=IF(RC11<180,0,"""")"
If Application.WorksheetFunction.CountIf(Bereich, 0) > 0 Then
Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
End If
.Columns(.Columns.Count).Delete
End With
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Sub Wenn_Mit_Ueberschrift()
Dim Bereich As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
With ThisWorkbook.Sheets("Tabelle1")
Set Bereich = .Range("K2", .Cells(Rows.Count, 11).End(xlUp))
If Intersect(Bereich, Rows(1)) Is Nothing Then
Set Bereich = Bereich.Offset(0, .Columns.Count - Bereich.Column)
Bereich.FormulaR1C1 = "=IF(RC11<180,0,"""")"
If Application.WorksheetFunction.CountIf(Bereich, 0) > 0 Then
Bereich.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
End If
.Columns(.Columns.Count).Delete
End If
End With
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Gruß Tino