"Seriendruck" in Excel

Hallo zusammen,
ohne Euch mit den Details langweilen zu wollen, stellt sich die Situation wie folgt dar:
Ich habe eine Exceldatei.
In dieser befinden sich in den Spalten A-G "statische" Informationen.
In jeder Zeile werden Daten zu Personen erfasst.
So zum Beispielfür Person 1 in den Spalten I-K die Daten zu den Beschreibungen in den Zellen A-G.
Für Person 2 in den Spalten M-O, für Person 3 in den Spalten Q-S, usw.
Am Ende der Datenerhebung soll nun jede Person die "statischen" Daten, also die Spalten A-G und die spezifischen Daten, bei Person 2 also zusätzlich die Spalten Q-S, auf einem DinA4-Blatt ausgefruckt bekommen.
Dies soll bestensfalls für alle Personen automatisch passieren.
Lässt sich dies irgendwie einrichten/programmieren?
Bin für jede Antwort dankbar.
Grüße,
tb

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo tb,
hier ein Beispielmakro, das du entsprechend anpassen muss.
Gruß
Franz

Sub SerienDruck()
Dim wksData As Worksheet, wksBrief As Worksheet
Dim ZeileD&, ZeileL&, SpalteD&, SpalteL&
Const SpalteP1 = 9 'Spalte I - 1. Spalte mit Info zu Person 1
Set wksData = Worksheets("Daten")
Set wksBrief = Worksheets("Brief")
With wksData
ZeileL = .Cells(.Rows.Count, 1).End(xlUp).Row
'Datenzeilen ab Zeile 2 abarbeiten
For ZeileD = 2 To ZeileL
'Letzte Datenspalte in Zeile
SpalteL = .Cells(ZeileD, .Columns.Count).End(xlToLeft).Column
'Prüfen, ob Personen eingetragen sind
If SpalteL >= SpalteP1 Then
'Feste infos Eintragen in Brief
wksBrief.Range("C6") = .Cells(ZeileD, 1).Value 'Feld01 - Spalte A
wksBrief.Range("C7") = .Cells(ZeileD, 2).Value 'Feld02 - Spalte B
wksBrief.Range("C8") = .Cells(ZeileD, 3).Value 'Feld03 - Spalte C
wksBrief.Range("C9") = .Cells(ZeileD, 4).Value 'Feld04 - Spalte D
wksBrief.Range("C14") = .Cells(ZeileD, 5).Value 'Feld05 - Spalte E
wksBrief.Range("C15") = .Cells(ZeileD, 6).Value 'Feld06 - Spalte F
wksBrief.Range("C16") = .Cells(ZeileD, 7).Value 'Feld07 - Spalte G
'Variable Infos eintragen und Drucken
For SpalteD = SpalteP1 To SpalteL Step 4
wksBrief.Range("C11") = .Cells(ZeileD, SpalteD + 0).Value 'Info 1 - Spalten I - M - Q
wksBrief.Range("D11") = .Cells(ZeileD, SpalteD + 1).Value 'Info 2 - Spalten J - N - R  _
wksBrief.Range("E11") = .Cells(ZeileD, SpalteD + 2).Value 'Info 3 - Spalten K - O - S
wksBrief.PrintOut Preview:=True
Next
End If
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

"Seriendruck" in Excel

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread