Clever-Excel-Forum

Normale Version: VBA - Kassenbuch pro Leistung neue Zeile
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
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
Hallo Steffen,


Zitat: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.
Hallo Klaus-Dieter,

ist doch auch so..

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

Huh
Hallo,

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

(25.02.2020, 10:27)SteBen schrieb: [ -> ]Hat jemand eine Idee, was ich falsch mache?

Du ermittelst die erste freie Zeile nur einmal! Wink

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
Hi Uwe,

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

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

Gruß Uwe
Mega, genau das hat mir gefehlt!! Danke Dir!! 

:05: