Sub
Test()
Dim
vArr
As
Variant
, i
As
Long
vArr = Range(
"$A1:$B"
& Cells(Rows.Count,
"A"
).
End
(xlUp).Row)
For
i = 1
To
UBound(vArr)
If
InStr(
"Auto,Baum,Fahrrad"
, vArr(i, 1)) > 0
Then
vArr(i, 2) =
"A"
Next
Range(
"$A1"
).Resize(UBound(vArr), 2) = vArr
End
Sub