Zeilenumbruch
18.07.2023 16:32:06
Pascal
da es vorhin super mit einer Lösung geklappt hat gleich die nächste Problemstellung.
Es geht weiterhin um eine Berichtserstellung, die wir automatisieren wollen. Hintergrund ist der, dass meine Kollegen und ich es alle zu uneinheitlich machen.
1. Auf einem Worksheet soll der Bericht geschrieben werden mit per Makro einzufügenden Zeilen - funktioniert (wenn auch evtl. hässlich, aber hey...)
2. Der ausgefüllte dynamische Bereich soll kopiert werden. - funktioniert
3. Der kopierte Teil soll ab einer bestimmten Stelle in einem anderen Blatt eingefügt werden - funktioniert jetzt (dank der genialen community)
4. Die kopierten/eingefügten zusammenhängenden Abschnitte sollen beim Seitenumbruch (A4 Format) nicht zerstückelt werden. Im Idealfall sollten keine Hurenkinder und Schusterjungen entstehen.
Wie stellet man das an?
Abfragen wie viele Zeilen zum Seitenumruch übrig sind und diese dann durch leerzeilen ersetzen, damit ein Zusammenhängender Block nicht zerissen wird?
Bzw. Die Daten sind ja bereits reinkopiert, also vielleicht eine nachträgliche bereinigung.
Habe einen sehr ähnlichen thread hier im Forum gefunden. Leider wurde die Lösung scheinbar per pn auf einem anderen Forum beantwortet... verstehe wer will =).
So kopiert er den dynamischen Bereich und fügt ihn ein... und macht mir woanders was zur bestätigung bunt =)
Sub Bereichsauswahl_Bericht()
' markiert dynamisch den ausgefüllten Bericht aus und kopiert ihn
Dim sht As Worksheet, rf As Worksheet
Dim LR As Long
Dim rng As Range
Dim zeil As Long
Set sht = Worksheets("Tabelle1")
Set rf = Worksheets("report full")
LR = sht.Cells.Find("*", _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set rng = sht.Range("C3:K" & LR)
rng.Copy rf.Cells(22, 1)
For zeil = rng.Row To rng.Row + rng.Rows.Count - 1 'durch alle Zeilen des Bereichs gehen
rf.Rows(zeil + 19).RowHeight = sht.Rows(zeil).RowHeight 'höhe kopieren
Next zeil
Range("C18").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5287936
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("C18").Value = "Datenübertragung erfolgreich!"
Range("C26").Value = Format(Now, "hh:mm dd.mm.yy")
End Sub
Hier noch die Datei um die es sich handelt
https://www.herber.de/bbs/user/159975.xlsm
Vielen Dank schonmal für die Antworten =D
