Option Explicit
Sub FiltDel()
Dim lngL As Long, rngDel As Range
Selection.AutoFilter Field:=27, Criteria1:="=w*", Operator:=xlAnd
lngL = Cells(Rows.Count, 27).End(xlUp).Row
Set rngDel = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If Not rngDel Is Nothing Then
rngDel = Intersect(rngDel, Range(Cells(2, "B"), Cells(lngL, "AY")))
If Not rngDel Is Nothing Then
MsgBox rngDel.Address ' nur zum Testen
rngDel.ClearContents ' oder Clear ?
' oder
rngDel.Delete xlShiftToLeft ' oder xlShiftUp ?
End If
End If
End Sub
Option Explicit
Sub FiltDel()
Dim lngL As Long, rngDel As Range
Selection.AutoFilter Field:=27, Criteria1:="=w*", Operator:=xlAnd
lngL = Cells(Rows.Count, 27).End(xlUp).Row
Set rngDel = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If Not rngDel Is Nothing Then
Set rngDel = Intersect(rngDel, Range(Cells(2, "B"), Cells(lngL, "AY")))
If Not rngDel Is Nothing Then
'MsgBox rngDel.Address ' nur zum Testen
' rngDel.ClearContents ' oder Clear ?
' oder
rngDel.Delete xlShiftToLeft ' oder xlShiftUp ?
End If
End If
End Sub
Public Sub Test_löschen()
Dim lngL As Long, rngDel As Range
Selection.AutoFilter Field:=27, Criteria1:="=w*", Operator:=xlAnd
lngL = Cells(Rows.Count, 1).End(xlUp).Row
Set rngDel = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
If Not rngDel Is Nothing Then
Set rngDel = Intersect(rngDel, Range(Cells(4, "B"), Cells(lngL, "AY")))
If Not rngDel Is Nothing Then
'MsgBox rngDel.Address ' nur zum Testen
' rngDel.ClearContents ' oder Clear ?
' oder
' rngDel.Delete xlShiftToLeft ' oder xlShiftUp ?
rngDel.Delete Shift:=xlUp
End If
End If
End Sub
Sub Test_löschen2()
Dim lngL As Long, rngDel As Range
Selection.AutoFilter Field:=27, Criteria1:="=w*", Operator:=xlAnd
lngL = Cells(Rows.Count, 27).End(xlUp).Row
If lngL Sub test()
Dim rngA As Range, rngB As Range
With ActiveSheet
Set rngA = .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).EntireRow
Set rngB = .Cells.SpecialCells(xlCellTypeVisible)
If Not Intersect(rngA, rngB) Is Nothing Then
Intersect(rngA, rngB).Delete 'komplette Zeilen löschen
'oder
'Intersect(rngA, rngB, .Columns("B:AY")).Delete shift:=xlShiftUp 'Zeilenbereiche löschen
End If
End With
End Sub