Hallo Andreas,
Code in Tabelle1 einfügen.
Gruß
fedjo
Option Explicit
Sub Filter()
Application.ScreenUpdating = False ' Tabellenwechsel unterbinden
[list] Dim c, firstAddress
Dim strSuch As String, rngBer As Range
Set rngBer = Range("A2:A" & Range("A65536").End(xlUp).Row)
With rngBer
strSuch = InputBox("in Spalte: A", "Suchen", "Eingabe")
If strSuch = "" Then
Exit Sub
End If
Set c = .Find(strSuch, LookIn:=xlValues)
If c Is Nothing Then
MsgBox "Eintrag nicht vorhanden"
Exit Sub
Else
Worksheets(1).Columns("A:A").AutoFilter _
Field:=1, Criteria1:=strSuch, VisibleDropDown:=False 'keine Filteranzeige
Selection.SpecialCells(xlCellTypeVisible).Delete
End If
End With
End Sub[/list]
