VBA - Kassenbuch pro Leistung neue Zeile

[SteBen]

Hallo zusammen,

ich verzweifle gerade ein bisschen an folgendem Problem..

Ich habe einen Reiter ("Rechnung"), der mittels drop down mit den erbrachten Leistungen befüllt wird. Anhand der Auwahl soll dann die entsprechende Leistung mit dem entsprechenden Betrag automatisch ins Kassenbuch übernommen werden. So weit, so gut - das klappt.

Das Problem ist aber, ich habe 3 Zeilen für je eine Leistung, zu befüllen über drop down. Ich möchte, dass nur die Leistungen & Beträge aus den befüllten Zeilen ins Kassenbuch übernommen werden.
Habe das ganze versucht, mit folgendem Code umzusetzen. Der funktioniert auch, aber es wird immer nur die letzte Leistung übernommen, nicht aber die ersten beiden...

Code:

'On Error GoTo err

'Erste freie Zeile finden
Dim last1 As Long
last1 = Worksheets("Kassenbuch").Cells(Rows.Count, 2).End(xlUp).Row + 1
If Not Worksheets("Rechnung").Range("G10").Value = "" Then
'1. Leistung
Worksheets("Kassenbuch").Cells(last, 2).Value = Worksheets("Rechnung").Range("C66").Value
Worksheets("Kassenbuch").Cells(last, 4).Value = Worksheets("Rechnung").Range("G8").Value
Worksheets("Kassenbuch").Cells(last, 3).Value = Worksheets("Rechnung").Range("I66").Value
End If
If Not Worksheets("Rechnung").Range("G12").Value = "" Then
'2. Leistung
Worksheets("Kassenbuch").Cells(last, 2).Value = Worksheets("Rechnung").Range("C70").Value
Worksheets("Kassenbuch").Cells(last, 4).Value = Worksheets("Rechnung").Range("G8").Value
Worksheets("Kassenbuch").Cells(last, 3).Value = Worksheets("Rechnung").Range("I70").Value
End If
If Not Worksheets("Rechnung").Range("G14").Value = "" Then
'3. Leistung
Worksheets("Kassenbuch").Cells(last, 2).Value = Worksheets("Rechnung").Range("C74").Value
Worksheets("Kassenbuch").Cells(last, 4).Value = Worksheets("Rechnung").Range("G8").Value
Worksheets("Kassenbuch").Cells(last, 3).Value = Worksheets("Rechnung").Range("I74").Value
End If

err:
If err.Number <> 0 Then
MsgBox err.Number & vbCrLf & err.Description
End If

Hat jemand eine Idee, was ich falsch mache?

Besten Dank für Eure Hilfe im voraus

VG
SteBen

[Klaus-Dieter]

Hallo Steffen,

Das Problem ist aber, ich habe 3 Zeilen für je eine Leistung, zu befüllen über drop down.

in Excel gilt die Regel (Grundbedingung): ein Datensatz, eine Zeile. Wenn du das nicht beachtest, wirst du immer Schiffbruch erleiden, dafür ist Excel nicht eingerichtet. Am besten lädst du mal deine (anonymisierte) Datei hier hoch.

[SteBen]

Hallo Klaus-Dieter,

ist doch auch so..

Erste Leistung wird in Zelle G10 gewählt, die nächtse in G12 & die letzte in G14.

[Klaus-Dieter]

Hallo,

dann habe ich nicht verstanden, was du meinst. Noch einmal die Bitte eine Beispieldatei einzustellen.

[SteBen]

anbei de Datei

[Kuwer]

Hallo,

Hat jemand eine Idee, was ich falsch mache?

Du ermittelst die erste freie Zeile nur einmal!

So wäre es richtig:

Dim last1 As Long

If Not Worksheets("Rechnung").Range("G10").Value = "" Then

'1. Leistung

'Erste freie Zeile finden

last1 = Worksheets("Kassenbuch").Cells(Rows.Count, 2).End(xlUp).Row + 1

Worksheets("Kassenbuch").Cells(last, 2).Value = Worksheets("Rechnung").Range("C66").Value

Worksheets("Kassenbuch").Cells(last, 4).Value = Worksheets("Rechnung").Range("G8").Value

Worksheets("Kassenbuch").Cells(last, 3).Value = Worksheets("Rechnung").Range("I66").Value

End If

If Not Worksheets("Rechnung").Range("G12").Value = "" Then

'2. Leistung

'Erste freie Zeile finden

last1 = Worksheets("Kassenbuch").Cells(Rows.Count, 2).End(xlUp).Row + 1

Worksheets("Kassenbuch").Cells(last, 2).Value = Worksheets("Rechnung").Range("C70").Value

Worksheets("Kassenbuch").Cells(last, 4).Value = Worksheets("Rechnung").Range("G8").Value

Worksheets("Kassenbuch").Cells(last, 3).Value = Worksheets("Rechnung").Range("I70").Value

End If

If Not Worksheets("Rechnung").Range("G14").Value = "" Then

'3. Leistung

'Erste freie Zeile finden

last1 = Worksheets("Kassenbuch").Cells(Rows.Count, 2).End(xlUp).Row + 1

Worksheets("Kassenbuch").Cells(last, 2).Value = Worksheets("Rechnung").Range("C74").Value

Worksheets("Kassenbuch").Cells(last, 4).Value = Worksheets("Rechnung").Range("G8").Value

Worksheets("Kassenbuch").Cells(last, 3).Value = Worksheets("Rechnung").Range("I74").Value

End If



err:

If err.Number <> 0 Then

MsgBox err.Number & vbCrLf & err.Description

End If

Gruß Uwe

[SteBen]

Hi Uwe,

klappt leider noch nicht ganz. Es wird nach wie vor nur die letzte Leistung übernommen?

[Kuwer]

Hallo,

das hatte ich übersehen: du musst natürlich die Variable last1 dann auch bei den Zellenzuweisungen verwenden.

Gruß Uwe

[SteBen]

Mega, genau das hat mir gefehlt!! Danke Dir!! 

:05: