Option
Explicit
Sub
Bsp()
Dim
rngResult
As
Excel.Range
Dim
rngCurCell
As
Excel.Range
Dim
strAddr
As
String
With
Worksheets(
"Tabelle1"
)
Set
rngCurCell = .Range(
"A2"
)
With
.Range(rngCurCell, .Cells(.Rows.Count, rngCurCell.Column).
End
(xlUp))
Set
rngResult = .Find(
"KOA*"
, LookIn:=xlValues, LookAt:=xlWhole)
If
Not
rngResult
Is
Nothing
Then
strAddr = rngResult.Address
Do
.Worksheet.Range(rngCurCell, rngResult.Offset(-1)).Offset(, 1).Value = rngResult.Value
Set
rngCurCell = rngResult.Offset(1)
Set
rngResult = .FindNext(After:=rngResult)
Loop
While
rngResult.Address <> strAddr
End
If
End
With
End
With
End
Sub