automatisch blattfüllend Leerzeilen einfügen?

Hallo zusammen,
versuche gerade unsere Inventurlisten-Erstellung etwas zu automatisieren...
In einem Tabellenblatt haben wir zig Einträge, je nach Zelleintrag in Spalte 'Inventurliste' werden die dann auf die einzelnen Blätter kopiert.
Soweit klappts ja.
Mein Problem ist eigentlich nur die letzte Seite, welche blattfüllend mit einer Zeile mit Datum-Unterschrift Zähler-Unterschrift Schreiber endet.
Diese Zeile in die Fußzeile zu packen macht ja auch wenig Sinn, da die ja nur auf der letzten Seite gedruckt werden soll.
Hab mir irgendwie sowas in der Art gedacht... gehe zur letzten Zeile, also der mit der Unterschrift, dann prüfe die Anzahl der Leerzeilen davor - mindestens 5 müssen vorhanden sein, danach soll das letzte Tabellenblatt blattfüllend mit Leerzeilen zwischen dem letzten Eintrag und der Unterschriftszeile aufgeüllt werden.
Ist sowas umsetzbar oder eher der falsche Weg?
hier noch ne Beispieldatei: wobei es halt nächstes Quartal wieder 3 oder 4 Seiten sein können
https://www.herber.de/bbs/user/122480.xlsx
Bin für jede Anregung dankbar. Gruß Bernd

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub xxx() Dim Zelle As Range Dim anzHPB As Long Set Zelle = Cells(Rows.Count, 1).End(xlUp).Offset(-1, 0) anzHPB = ActiveSheet.HPageBreaks.Count Do Zelle.EntireRow.Insert Shift:=xlDown Loop While ActiveSheet.HPageBreaks.Count = anzHPB Zelle.EntireRow.Delete End Sub

Sub xxx() Dim Zelle As Range Dim anzHPB As Long i = 5 'Mindestanzahl an Leerzeilen lz1 = Cells(1, 1).End(xlDown).Row 'letzte Zeile normale Inhalte lz2 = Cells(1048576, 1).End(xlUp).Row 'letzte Listende If lz1 = lz2 Then MsgBox "Unterschriftszeile fehlt! Makro wird vorzeitig beendet", vbCritical, "Fehler" Exit Sub End If anzl = lz2 - lz1 - 1 'Anzahl vorhandener Leerzeilen 'Einfügen der Mindestanzahl an Leerzeilen Set Zelle = Cells(Rows.Count, 1).End(xlUp).Offset(-1, 0) If anzl

Sub T_1() Dim WS As Worksheet: Set WS = ActiveSheet Dim Hp As HPageBreak lr = Cells(Rows.Count, 1).End(xlUp).Row Range("A1").End(xlDown).Offset(1).PageBreak = xlPageBreakManual MxL = WS.HPageBreaks.Item(1).Location.Row Lhp = WS.HPageBreaks.Item(WS.HPageBreaks.Count).Location.Row Einf = (lr - Lhp) Mod MxL Rows(Lhp & ":" & Lhp + Einf).Insert xlDown End Sub

Beliebteste Forumthreads (12 Monate)

automatisch blattfüllend Leerzeilen einfügen?

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

automatisch blattfüllend Leerzeilen einfügen?

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

310 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread