Drucken (Seriendruck?)

Bild

Betrifft: Drucken (Seriendruck?)
von: Schwoga
Geschrieben am: 24.04.2015 09:01:02

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

Bild

Betrifft: AW: Drucken (Seriendruck?)
von: fcs
Geschrieben am: 27.04.2015 07:29:11
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


Bild

Betrifft: AW: Drucken (Seriendruck?)
von: Schwoga
Geschrieben am: 27.04.2015 15:36:10
Hallo Franz,
danke für deine Lösung. Klappt super.
Gruß
Schwoga

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Drucken (Seriendruck?)"