Option
Explicit
Sub
Filter()
Dim
strSuche
As
String
strSuche = InputBox(
"Suche nach:"
,
"Suchbegriff"
)
strSuche =
"*"
& strSuche &
"*"
Range(
"F2:I5"
).ClearContents
Range(
"F2"
).Value = strSuche
Range(
"G3"
).Value = strSuche
Range(
"H4"
).Value = strSuche
Range(
"I5"
).Value = strSuche
Sheets(
"Tabelle1"
).Range(
"A1:D7"
).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Sheets(
"Tabelle1"
).Range(
"F1:I5"
), _
CopyToRange:=Sheets(
"Tabelle1"
).Range(
"K1:N1"
), _
Unique:=
False
End
Sub