Public
Sub
Instrsuche()
With
ActiveWorkbook.ActiveSheet
If
.FilterMode
Then
.ShowAllData
End
If
End
With
Rows(
"7:7"
).
Select
Selection.AutoFilter
Dim
intwort
As
String
, intgef
As
Integer
, wks1
As
Worksheet, Zelle
As
Range
Range(
"a7:o1000"
).ClearContents
Set
wks1 = ThisWorkbook.Sheets(
"Portfolio FA_RG"
)
intgef = 8
intwort = InputBox(
"Suchbegriff oder (*) eingeben:"
)
If
intwort =
""
Then
Exit
Sub
For
Each
Zelle
In
wks1.Range(
"a4:s"
& wks1.UsedRange.Rows.Count)
If
InStr(1, Zelle.Value, intwort, vbTextCompare)
Then
Cells(intgef, 1) = wks1.Cells(Zelle.Row, 1)
Cells(intgef, 2) = wks1.Cells(Zelle.Row, 5)
Cells(intgef, 3) = wks1.Cells(Zelle.Row, 6)
Cells(intgef, 4) = wks1.Cells(Zelle.Row, 7)
Cells(intgef, 5) = wks1.Cells(Zelle.Row, 8)
Cells(intgef, 6) = wks1.Cells(Zelle.Row, 12)
Cells(intgef, 7) = wks1.Cells(Zelle.Row, 13)
Cells(intgef, 8) = wks1.Cells(Zelle.Row, 10)
Cells(intgef, 9) = wks1.Cells(Zelle.Row, 11)
Cells(intgef, 10) = wks1.Cells(Zelle.Row, 14)
Cells(intgef, 11) = wks1.Cells(Zelle.Row, 15)
Cells(intgef, 12) = wks1.Cells(Zelle.Row, 16)
Cells(intgef, 13) = wks1.Cells(Zelle.Row, 17)
Cells(intgef, 14) = wks1.Cells(Zelle.Row, 18)
Cells(intgef, 15) = wks1.Cells(Zelle.Row, 19)
intgef = intgef + 1
End
If
Next
Application.Wait Now + TimeValue(
"00:00:01"
)
Rows(
"7:7"
).
Select
Selection.AutoFilter
End
Sub