Sub
Real()
Dim
TB1
As
Worksheet, TB2
As
Worksheet, Sp
As
Integer
, Zeile
As
Long
, ZielZ
As
Integer
Dim
Suchwort
As
String
, LR
As
Long
Set
TB1 = Sheets(
"Phantasie"
)
Set
TB2 = Sheets(
"Realität"
)
ZielZ = 1
Sp = 1
Suchwort = InputBox(
"Was suchst du?"
)
If
Suchwort <>
""
Then
LR = TB1.Cells(TB1.Rows.Count, Sp).
End
(xlUp).Row
Zeile = WorksheetFunction.CountIf(TB1.Columns(Sp), Suchwort)
If
Zeile > 0
Then
TB2.UsedRange.Clear
Zeile = WorksheetFunction.Match(Suchwort, TB1.Columns(Sp), 0)
TB1.Rows(Zeile).Resize(LR - Zeile + 1).Copy TB2.Rows(ZielZ)
End
If
End
If
End
Sub