|
Hallo, ich habe die Lösung selbst gefunden!!
Sub uebertragen()
Dim ez As Integer, i As Integer
Dim k1g As Single, e1g As Single, f1g As Single
'ez ermitteln
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
|