Daten aus Tabelle in 2. Tabelle archivie
20.10.2022 21:21:53
Eleftherios
ich möchte die Daten aus der Kasseneingabe, eine Tabelle mit 24Zeilen + Kopfzeile nachdem Sie gebucht sind in ein Journal eintragen lassen das endlos bzw. bis zur Archivierung fortgeführt wird.
Leider bekomme ich es nicht hin das er die Daten in die Journal Tabelle (tbl_Journal) einträgt sondern unter der Tabelle d.h. er erweitert die Tabelle nicht.
Die Daten in den Zellen O39, K39, F26 Sind außerhalb der Tabelle Kasseneingabe sollen jedoch auch in das Journal mit eingetragen werden, was auch passiert nur mit oben genanntem Fehler.
Mein 2. Problem ist, ich bekomme den Code nur separat zum laufen dieser müsste aber in den Buchungscode integriert werden.
Das ist der Code für den Journaleintrag,
Sub Journal_click()
'In Journal eintragen
z = 0
Call ws_Unprotect("Kasseneingabe", "Journal")
Start:
If Worksheets("Kasseneingabe").Range("K15").Offset(z, 0) "" Then
Worksheets("Journal").Activate
Dim lngZeile As Long, lngSpalte As Long
lngSpalte = 1
lngZeile = Cells(Rows.Count, lngSpalte).End(xlUp).Row + 1
Cells(lngZeile, lngSpalte).Offset(0, 0) = Worksheets("Kasseneingabe").Range("O39")
Cells(lngZeile, lngSpalte).Offset(0, 1) = Worksheets("Kasseneingabe").Range("K39")
Cells(lngZeile, lngSpalte).Offset(0, 2) = Worksheets("Kasseneingabe").Range("F26")
Cells(lngZeile, lngSpalte).Offset(0, 3) = Worksheets("Kasseneingabe").Range("K15").Offset(z, 0)
Cells(lngZeile, lngSpalte).Offset(0, 4) = Worksheets("Kasseneingabe").Range("L15").Offset(z, 0)
Cells(lngZeile, lngSpalte).Offset(0, 5) = Worksheets("Kasseneingabe").Range("M15").Offset(z, 0)
Cells(lngZeile, lngSpalte).Offset(0, 6) = Worksheets("Kasseneingabe").Range("N15").Offset(z, 0)
Cells(lngZeile, lngSpalte).Offset(0, 7) = Worksheets("Kasseneingabe").Range("O15").Offset(z, 0)
Cells(lngZeile, lngSpalte).Offset(0, 8) = Worksheets("Kasseneingabe").Range("P15").Offset(z, 0)
Cells(lngZeile, lngSpalte).Offset(0, 9) = Worksheets("Kasseneingabe").Range("Q15").Offset(z, 0)
'Worksheets("Kasseneingabe").Activate
z = z + 1
GoTo Start
Else
MsgBox "Abgeschlossen"
End If
Call ws_Protect("Kasseneingabe", "Journal")
End Sub
Sub BuchenMitOhneDruck()
Call ws_Unprotect("Kasseneingabe", "Rechnungsdruck")
'Application.ScreenUpdating = False
'Daten aus Tabelle06 kopieren und in Rechnungsdruck einfügen
Range("K15:P38").Copy
Sheets("Rechnungsdruck").Range("I29:N52").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Rechnungsdruck als PDF speichern
Tabelle09.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Tabelle12.Range("J12").Value & "\" & Range("O39").Value _
& "_" & Format(Date, "YYYYMMDD") & ".pdf", Quality:=xlQualityStandard, OpenAfterPublish:=True
'Daten in Journal Buchen (Ich Schätze hier sollte der Code anfangen bevor die Daten aus der Kasseneingabe gelöscht werden.
Application.EnableEvents = False
'Daten aus Kasseneingabe Löschen
Worksheets("kasseneingabe").Select
Range("K15:Q38").ClearContents
Range("F16:G17").ClearContents
Range("I16:I17").ClearContents
Range("F19:F20").ClearContents
'Rechnung Drucken
If ActiveSheet.Shapes(Application.Caller).Name = "Sh_MitDruck" Then
Tabelle09.PrintOut Copies:=1, Preview:=True
End If
'Rechnungsnummer um 1 erhöhen
Range("O39").Value = Range("O39").Value + 1
'Nach Buchung auf Barcode Springen
Range("F16:G17").Select
' Application.EnableEvents = True
' Application.ScreenUpdating = True
Call ws_Protect("Rechnungsdruck", "Kasseneingabe")
End Sub
Da meine ExcelDatei mittlerweile bei ca. 1MB ist kann ich sie leider nicht hochladen aber bei Interesse sende ich diese gerne per mail.
Ich Danke Euch mal wieder im Voraus
LG Lefty