Sub
uebertragen()
Dim
ez
As
Integer
, i
As
Integer
Dim
k1g
As
Single
, e1g
As
Single
, f1g
As
Single
i = 6
Do
Until
(ActiveSheet.Cells(i, 1) =
""
)
i = i + 1
Loop
ez = i - 1
For
i = 6
To
ez
If
(Worksheets(
"Daten"
).Cells(i, 2) <>
""
)
Then
k1g = ActiveSheet.Cells(i, 3) / 100
e1g = ActiveSheet.Cells(i, 4) / 100
f1g = ActiveSheet.Cells(i, 5) / 100
Worksheets(
"Daten"
).Cells(i, 2).Copy
ActiveSheet.Paste Destination:=Worksheets(
"Salat-Mix"
).Cells(i, 2)
Worksheets(
"Salat-Mix"
).Cells(i, 3).FormulaLocal =
"="
& Worksheets(
"Salat-Mix"
).Cells(i, 2) &
"*"
& k1g
Worksheets(
"Salat-Mix"
).Cells(i, 4).FormulaLocal =
"="
& Worksheets(
"Salat-Mix"
).Cells(i, 2) &
"*"
& e1g
Worksheets(
"Salat-Mix"
).Cells(i, 5).FormulaLocal =
"="
& Worksheets(
"Salat-Mix"
).Cells(i, 2) &
"*"
& f1g
Else
End
If
Next
i
End
Sub