Option
Explicit
Sub
FindenUndKopieren01()
Dim
rng
As
Range
Dim
loDeinWert
As
String
Dim
sFirstAdress
As
String
loDeinWert =
"FROM"
Set
rng = Worksheets(
"Tabelle1"
).Range(
"A1:A5000"
).Find(loDeinWert)
If
rng
Is
Nothing
Then
MsgBox
"Wort "
& loDeinWert &
" nicht gefunden!"
Else
sFirstAdress = rng.Address
Do
Cells(12, 2) = Cells(12, 1)
Set
rng = Worksheets(
"Tabelle1"
).Range(
"A:B"
).FindNext(rng)
Loop
While
Not
rng
Is
Nothing
And
rng.Address <> sFirstAdress
End
If
End
Sub