Seriendruck in Excel aus Excel

Salut!
Ich bin auf der Suche nach einem passenden VBA Code fuer einen Seriendruck in Excel ohne dabei auf Word zurueckgreifen zu muessen. Aus einer Quelltabelle (adr) sollen also Daten aus Zeilen nacheinander in ein anderes Tabellenblatt (form) uebernommen werden und dann ausgedruckt werden. Dabei soll jedoch immer erst nach der Uebernahme von drei Datensaetzen der Druck des Formblattes (form) erfolgen, einfach um Papier zu sparen. Ausserdem sollen nur diejenigen Datensaetze beruecksichtigt werden, die in der Quelltabelle mit einem x gekennzeichent sind. Aktuell habe ich folgenden Code dafuer herangezogen.

Public Sub Seriendruck()
For a = 1 To Sheets("adr").Cells(1, 1).End(xlDown).Row
If CStr(Sheets("adr").Cells(a, 4)) = "x" Then
If CStr(Sheets("adr").Cells(a, 3)) = "m" Then
Sheets("form").Cells(1, 2).Value = "Herrn"
Else: Sheets("form").Cells(1, 2).Value = "Frau"
End If
Sheets("form").Cells(1, 3).Value = CStr(Sheets("adr").Cells(a, 2))
Sheets("form").Cells(1, 4).Value = CStr(Sheets("adr").Cells(a, 1))
End If
Sheets("form").Activate
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next a
End Sub

Dieser gibt allerdings nur vor, ausschliesslich die mit x gekennzeichenten Datensaetze zu drucken. Tatsaechlich werden jedes Mal alle rausgelassen. Ausserdem erfolgt der Druck nach jedem Datensatz, sodass nur eine Zeile auf jedem A4 Blatt steht. Wie kann ich den Code so modifizieren, dass die beiden Faktoren beruecksichtigt werden?
Hier noch Bilder der beiden Tabellen. Sehr simpel - nur Namen.
Userbild

Merci d'avance!

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Public Sub Seriendruck() Dim wksAdr As workshet, wksForm As Worksheet, iCount As Integer Dim a As Long, ZeileF As Long Set wksAdr = Sheets("adr") Set wksForm = Sheets("form") wksForm.Activate Const ZeileF1 = 1 'Zeile für 1. Adresssatz ZeileF = ZeileF1 For a = 1 To wksAdr.Cells(1, 1).End(xlDown).Row If CStr(wksAdr.Cells(a, 4)) = "x" Then If CStr(wksAdr.Cells(a, 3)) = "m" Then wksForm.Cells(ZeileF, 2).Value = "Herrn" Else wksForm.Cells(ZeileF, 2).Value = "Frau" End If wksForm.Cells(ZeileF, 3).Value = wksAdr.Cells(a, 2).Text wksForm.Cells(ZeileF, 4).Value = wksAdr.Cells(a, 1).Text End If iCount = iCount + 1 If iCount = 3 Then wksForm.PrintOut Copies:=1, Collate:=True iCount = 0 'Hier ggf. noch alle Zellen leeren, in die Adressdaten eingetragen werden With wksForm .Range("B1:E3").ClearContents End With ZeileF = ZeileF1 Else ZeileF = ZeileF + 1 '1 ggf. anpassen, damit Adressen 2 und 3 in korrekte _ Zeile eingetragen werden End If Next a If iCount > 0 Then wksForm.PrintOut Copies:=1, Collate:=True End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread