Severus schrieb am 06.11.2010 19:31:28:
Wenn ich Deinen Code richtig verstanden habe, sollte es so gehen:
Private Sub CommandButton1_Click()
Dim SUMME As Double
Dim z As Long
SUMME = 0#
ActiveWorkbook.Worksheets("Kundendaten").Select
z = ActiveSheet.[A65536].End(xlUp).Row + 1
Cells(z, 1) = Date
Cells(z, 1).Select
i = 0
Do
i = 1 + i
Loop Until ActiveCell.Offset(0, i) = ""
ActiveCell.Offset(0, i).Value = Leistungstabelle
ActiveCell.Offset(1, i).Value = Leistungstabelle1
ActiveCell.Offset(2, i).Value = Leistungstabelle2
ActiveCell.Offset(3, i).Value = Leistungstabelle3
ActiveCell.Offset(4, i).Value = Leistungstabelle4
ActiveCell.Offset(5, i).Value = Leistungstabelle5
ActiveCell.Offset(6, i).Value = Leistungstabelle6
ActiveCell.Offset(7, i).Value = Leistungstabelle7
ActiveCell.Offset(8, i).Value = Leistungstabelle8
ActiveCell.Offset(9, i).Value = Leistungstabelle9
Cells(z, 2).Select
i = 0
Do
i = i + 1
Loop Until ActiveCell.Offset(0, i) = ""
ActiveCell.Offset(0, i).Value = Faktor
ActiveCell.Offset(1, i).Value = Faktor1
ActiveCell.Offset(2, i).Value = Faktor2
ActiveCell.Offset(3, i).Value = Faktor3
ActiveCell.Offset(4, i).Value = Faktor4
ActiveCell.Offset(5, i).Value = Faktor5
ActiveCell.Offset(6, i).Value = Faktor6
ActiveCell.Offset(7, i).Value = Faktor7
ActiveCell.Offset(8, i).Value = Faktor8
ActiveCell.Offset(9, i).Value = Faktor9
Cells(z, 3).Select
i = 0
Do
i = i + 1
Loop Until ActiveCell.Offset(0, i) = ""
If Leistungstabelle = "" Then ActiveCell.Offset(0, i).Value = "" Else ActiveCell.Offset(0, i).Value = Application.WorksheetFunction.VLookup([B11], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle1 = "" Then ActiveCell.Offset(1, i).Value = "" Else ActiveCell.Offset(1, i).Value = Application.WorksheetFunction.VLookup([B12], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle2 = "" Then ActiveCell.Offset(2, i).Value = "" Else ActiveCell.Offset(2, i).Value = Application.WorksheetFunction.VLookup([B13], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle3 = "" Then ActiveCell.Offset(3, i).Value = "" Else ActiveCell.Offset(3, i).Value = Application.WorksheetFunction.VLookup([B14], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle4 = "" Then ActiveCell.Offset(4, i).Value = "" Else ActiveCell.Offset(4, i).Value = Application.WorksheetFunction.VLookup([B15], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle5 = "" Then ActiveCell.Offset(5, i).Value = "" Else ActiveCell.Offset(5, i).Value = Application.WorksheetFunction.VLookup([B16], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle6 = "" Then ActiveCell.Offset(6, i).Value = "" Else ActiveCell.Offset(6, i).Value = Application.WorksheetFunction.VLookup([B17], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle7 = "" Then ActiveCell.Offset(7, i).Value = "" Else ActiveCell.Offset(7, i).Value = Application.WorksheetFunction.VLookup([B18], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle8 = "" Then ActiveCell.Offset(8, i).Value = "" Else ActiveCell.Offset(8, i).Value = Application.WorksheetFunction.VLookup([B19], Sheets("Leistungen").[A2:B60], 2, False)
If Leistungstabelle9 = "" Then ActiveCell.Offset(9, i).Value = "" Else ActiveCell.Offset(9, i).Value = Application.WorksheetFunction.VLookup([B20], Sheets("Leistungen").[A2:B60], 2, False)
Cells(z, 4).Select
i = 0
Do
i = i + 1
Loop Until ActiveCell.Offset(0, i) = ""
If Leistungstabelle = "" Then ActiveCell.Offset(0, i).Value = "" Else ActiveCell.Offset(0, i).Value = Application.WorksheetFunction.VLookup([B11], Sheets("Leistungen").[A2:B60], 2, False) * Faktor
SUMME = SUMME + ActiveCell.Offset(0, i).Value
If Leistungstabelle1 = "" Then ActiveCell.Offset(1, i).Value = "" Else ActiveCell.Offset(1, i).Value = Application.WorksheetFunction.VLookup([B12], Sheets("Leistungen").[A2:B60], 2, False) * Faktor1
SUMME = SUMME + ActiveCell.Offset(1, i).Value
If Leistungstabelle2 = "" Then ActiveCell.Offset(2, i).Value = "" Else ActiveCell.Offset(2, i).Value = Application.WorksheetFunction.VLookup([B13], Sheets("Leistungen").[A2:B60], 2, False) * Faktor2
SUMME = SUMME + ActiveCell.Offset(2, i).Value
If Leistungstabelle3 = "" Then ActiveCell.Offset(3, i).Value = "" Else ActiveCell.Offset(3, i).Value = Application.WorksheetFunction.VLookup([B14], Sheets("Leistungen").[A2:B60], 2, False) * Faktor3
SUMME = SUMME + ActiveCell.Offset(3, i).Value
If Leistungstabelle4 = "" Then ActiveCell.Offset(4, i).Value = "" Else ActiveCell.Offset(4, i).Value = Application.WorksheetFunction.VLookup([B15], Sheets("Leistungen").[A2:B60], 2, False) * Faktor4
SUMME = SUMME + ActiveCell.Offset(4, i).Value
If Leistungstabelle5 = "" Then ActiveCell.Offset(5, i).Value = "" Else ActiveCell.Offset(5, i).Value = Application.WorksheetFunction.VLookup([B16], Sheets("Leistungen").[A2:B60], 2, False) * Faktor5
SUMME = SUMME + ActiveCell.Offset(5, i).Value
If Leistungstabelle6 = "" Then ActiveCell.Offset(6, i).Value = "" Else ActiveCell.Offset(6, i).Value = Application.WorksheetFunction.VLookup([B17], Sheets("Leistungen").[A2:B60], 2, False) * Faktor6
SUMME = SUMME + ActiveCell.Offset(6, i).Value
If Leistungstabelle7 = "" Then ActiveCell.Offset(7, i).Value = "" Else ActiveCell.Offset(7, i).Value = Application.WorksheetFunction.VLookup([B18], Sheets("Leistungen").[A2:B60], 2, False) * Faktor7
SUMME = SUMME + ActiveCell.Offset(7, i).Value
If Leistungstabelle8 = "" Then ActiveCell.Offset(8, i).Value = "" Else ActiveCell.Offset(8, i).Value = Application.WorksheetFunction.VLookup([B19], Sheets("Leistungen").[A2:B60], 2, False) * Faktor8
SUMME = SUMME + ActiveCell.Offset(8, i).Value
If Leistungstabelle9 = "" Then ActiveCell.Offset(9, i).Value = "" Else ActiveCell.Offset(9, i).Value = Application.WorksheetFunction.VLookup([B20], Sheets("Leistungen").[A2:B60], 2, False) * Faktor9
SUMME = SUMME + ActiveCell.Offset(9, i).Value
ActiveCell.Offset(9, i + 1).Value = SUMME
End Sub
Severus
Hallo Severus,
vielen vielen lieben Dank Dir erst einmal für deine Bemühungen.
Leider klappt es nicht, das die Werte beim zweiten Ausführen unter einander geschrieben werden.
Ich habe die Datei mal hochgeladen, vielleicht hilft dir das ja
http://www.file-upload.net/download-2954127/Mappe1.xls.html .
vielen Dank nochmals,
Marcel |