Thema: Drucken (Seriendruck?)

Hallo Leute,
ich hab schon wieder eine Frage. Ist es möglich, wie bei der Tabelle im Anhang, die Daten mittels Button aus der Tabelle "Daten" in die Tabellen "Druck1" "Druck2" automatisch zu übertragen, solange bis eine Leerzelle kommt? Die Tabellenblätter "Druck1" "Druck2" sollten dann nach Übertrag automatisch jeweils gedruckt werden.
Wäre schön, wenn das klappt, da es ein Haufen Zeit einsparen würde.
https://www.herber.de/bbs/user/97278.xlsx
Danke
Schwoga

Hallo Schwoga,
hier ein entsprechendes Makro. Den Ausgabedrucker ggf. vor Ausführung des des Makros auswählen.
Das Übertragen der Werte könnte man in deinem Fall (die Zellen mit den Daten sind in den Druckblättern genauso in 4 Zellen nebeneinander, wie im Blatt "Daten") auch in einer einfacheren Anweisung machen. Ich hab es aber mal zellenweise gemacht.
Gruß
Franz

Sub prcSeriendruck()
Dim wksDaten As Worksheet
Dim wksDruck1 As Worksheet
Dim wksDruck2 As Worksheet
Dim lngZeile As Long
Set wksDaten = ActiveWorkbook.Worksheets("Daten")
Set wksDruck1 = ActiveWorkbook.Worksheets("Druck1")
Set wksDruck2 = ActiveWorkbook.Worksheets("Druck2")
With wksDaten
For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
wksDruck1.Cells(4, 1).Value = .Cells(lngZeile, 1).Text 'Name
wksDruck1.Cells(4, 2).Value = .Cells(lngZeile, 2).Text 'Vorname
wksDruck1.Cells(4, 3).Value = .Cells(lngZeile, 3).Value 'Geburtsdatum
wksDruck1.Cells(4, 4).Value = .Cells(lngZeile, 4).Text 'Geburtsort
wksDruck2.Cells(4, 1).Value = .Cells(lngZeile, 1).Text 'Name
wksDruck2.Cells(4, 2).Value = .Cells(lngZeile, 2).Text 'Vorname
wksDruck2.Cells(4, 3).Value = .Cells(lngZeile, 3).Value 'Geburtsdatum
wksDruck2.Cells(4, 4).Value = .Cells(lngZeile, 4).Text 'Geburtsort
ActiveWorkbook.Sheets(Array(wksDruck1.Name, wksDruck2.Name)).PrintOut Preview:= _
False
wksDaten.Select
Next
End With
End Sub

Hallo Franz,
danke für deine Lösung. Klappt super.
Gruß
Schwoga

Hallo Leute,
ich hab schon wieder eine Frage. Ist es möglich, wie bei der Tabelle im Anhang, die Daten mittels Button aus der Tabelle "Daten" in die Tabellen "Druck1" "Druck2" automatisch zu übertragen, solange bis eine Leerzelle kommt? Die Tabellenblätter "Druck1" "Druck2" sollten dann nach Übertrag automatisch jeweils gedruckt werden.
Wäre schön, wenn das klappt, da es ein Haufen Zeit einsparen würde.
https://www.herber.de/bbs/user/97278.xlsx
Danke
Schwoga

Hallo Schwoga,
hier ein entsprechendes Makro. Den Ausgabedrucker ggf. vor Ausführung des des Makros auswählen.
Das Übertragen der Werte könnte man in deinem Fall (die Zellen mit den Daten sind in den Druckblättern genauso in 4 Zellen nebeneinander, wie im Blatt "Daten") auch in einer einfacheren Anweisung machen. Ich hab es aber mal zellenweise gemacht.
Gruß
Franz

Sub prcSeriendruck()
Dim wksDaten As Worksheet
Dim wksDruck1 As Worksheet
Dim wksDruck2 As Worksheet
Dim lngZeile As Long
Set wksDaten = ActiveWorkbook.Worksheets("Daten")
Set wksDruck1 = ActiveWorkbook.Worksheets("Druck1")
Set wksDruck2 = ActiveWorkbook.Worksheets("Druck2")
With wksDaten
For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
wksDruck1.Cells(4, 1).Value = .Cells(lngZeile, 1).Text 'Name
wksDruck1.Cells(4, 2).Value = .Cells(lngZeile, 2).Text 'Vorname
wksDruck1.Cells(4, 3).Value = .Cells(lngZeile, 3).Value 'Geburtsdatum
wksDruck1.Cells(4, 4).Value = .Cells(lngZeile, 4).Text 'Geburtsort
wksDruck2.Cells(4, 1).Value = .Cells(lngZeile, 1).Text 'Name
wksDruck2.Cells(4, 2).Value = .Cells(lngZeile, 2).Text 'Vorname
wksDruck2.Cells(4, 3).Value = .Cells(lngZeile, 3).Value 'Geburtsdatum
wksDruck2.Cells(4, 4).Value = .Cells(lngZeile, 4).Text 'Geburtsort
ActiveWorkbook.Sheets(Array(wksDruck1.Name, wksDruck2.Name)).PrintOut Preview:= _
False
wksDaten.Select
Next
End With
End Sub

Hallo Franz,
danke für deine Lösung. Klappt super.
Gruß
Schwoga