Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Brauche dringend Hilfe bei meinen Makro

Forumthread: Brauche dringend Hilfe bei meinen Makro

Brauche dringend Hilfe bei meinen Makro
03.12.2003 10:49:32
Scotty
Hallo alle zusammen,

habe bei folgenden Makro Probleme:


Sub MultiSpaltenDruck()
Dim rng As Range
Dim iRow As Integer, iCountR As Integer
Dim iRowT As Integer, iColT As Integer
Dim iCounter As Integer
Application.ScreenUpdating = False
Set rng = Range("A1").CurrentRegion
iCountR = 36
Workbooks.Add 1
iRow = 1
iRowT = 1
iColT = 1
Do While iRow <= rng.Rows.Count
For iCounter = 1 To 2
rng.Range(rng.Cells(iRow, 1), _
rng.Cells(iRow + iCountR - 1, 6)).Copy _
Cells(iRowT, iColT)
iRow = iRow + iCountR
iColT = iColT + 7
Next iCounter
ActiveSheet.PrintPreview
iColT = 1
Loop
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = False
End Sub


Habe 6 schmale Spalten im Querformat. Beim ausdrucken sollen die 6 Spalten der Seite 2 mit auf Seite 1 usw. Ansich funktioniert das Makro. Es gibt nur 2 Probleme: Mein Arbeitsblatt ist im Querformat. Das Makro zeigt aber bei der Druckvorschau Hochformat an. Die Spalten passen dann nicht auf das Blatt. 2. Problem: Die Tabelle geht über mehrere Seiten. Das Makro (Siehe oben:Tabellenumbruch Zeile 36)funktioniert nur auf den ersten beiden Seiten. Wenn man die Zeile 'iCountR = 36' irgendwie ändern könnte, das jede beschriebene Seite am Seitenende "umgebrochen" wird, wäre das Makro perfekt.

Vielleicht kann mir jemand helfen. Bin für jeden Vorschalg dankbar.
Gruß Scotty
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Brauche dringend Hilfe bei meinen Makro
06.12.2003 17:55:44
Beni
Hallo Scotty,
ich habe es getestet und hat funktioniert.
Gruss Beni

https://www.herber.de/bbs/user/2345.xls


Sub MultiSpaltenDruck()
Dim rng As Range
Dim iRow As Integer, iCountR As Integer
Dim iRowT As Integer, iColT As Integer
Dim iCounter As Integer
Application.ScreenUpdating = False
Set rng = Range("A1").CurrentRegion
iCountR = 36
Workbooks.Add 1
Columns("A:O").ColumnWidth = 7 '<<<<<<<
iRow = 1
iRowT = 1
iColT = 1
Do While iRow <= rng.Rows.Count
For iCounter = 1 To 2
rng.Range(rng.Cells(iRow, 1), _
rng.Cells(iRow + iCountR - 1, 6)).Copy _
Cells(iRowT, iColT)
iRow = iRow + iCountR
iColT = iColT + 7
Next iCounter
ActiveSheet.PageSetup.Orientation = xlLandscape '<<<<<<
ActiveSheet.PrintPreview
iColT = 1
Loop
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Brauche dringend Hilfe bei meinen Makro
06.12.2003 17:56:30
Beni
Hallo Scotty,
ich habe es getestet und hat funktioniert.
Gruss Beni

https://www.herber.de/bbs/user/2345.xls


Sub MultiSpaltenDruck()
Dim rng As Range
Dim iRow As Integer, iCountR As Integer
Dim iRowT As Integer, iColT As Integer
Dim iCounter As Integer
Application.ScreenUpdating = False
Set rng = Range("A1").CurrentRegion
iCountR = 36
Workbooks.Add 1
Columns("A:O").ColumnWidth = 7 '<<<<<<<
iRow = 1
iRowT = 1
iColT = 1
Do While iRow <= rng.Rows.Count
For iCounter = 1 To 2
rng.Range(rng.Cells(iRow, 1), _
rng.Cells(iRow + iCountR - 1, 6)).Copy _
Cells(iRowT, iColT)
iRow = iRow + iCountR
iColT = iColT + 7
Next iCounter
ActiveSheet.PageSetup.Orientation = xlLandscape '<<<<<<
ActiveSheet.PrintPreview
iColT = 1
Loop
ActiveWorkbook.Close savechanges:=False
Application.ScreenUpdating = True
End Sub

Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige