Option
Explicit
Sub
Test()
Dim
i
As
Long
Dim
c
As
Range
Sheets(
"Basis"
).Range(
"B2"
).Value = 0
Application.ScreenUpdating =
False
For
i = 1
To
500
Sheets(
"Basis"
).Range(
"B2"
) = _
Sheets(
"Basis"
).Range(
"B2"
) + 1
Sheets(
"Basis"
).Calculate
With
Sheets(
"Untersuchung"
)
Set
c = .Columns(
"A"
).Find(Sheets(
"Basis"
).Range(
"B2"
).Value)
c.Offset(0, 1).Value = Sheets(
"Basis"
).Range(
"B5"
).Value
c.Offset(0, 2).Value = Sheets(
"Basis"
).Range(
"C5"
).Value
End
With
Next
i
Application.ScreenUpdating =
True
End
Sub