killtec
Sep 19, 2014, updated at Sep 22, 2014 (UTC)
view5244
view10
0
Goto Top

Seitenumbruch in Excel soll neue Tabelle sein

GermansolvedQuestionMicrosoft OfficeMicrosoft
Hallo zusammen,
ein Kollege trat gerade an mich ran und hatte gefragt, ob es möglich ist, eine Exceltabelle die 53 Seiten hat entsprechend aufzuteilen, so dass nicht alle 53 Seiten in einer Tabelle sind, sondern jedes mal, wo ein Seitenumbruch ist, eine neue Tabelle anfängt.

Kennt jemand so eine Möglichkeit? (Ich vermute mal es würde in Richtung VBA gehen?)

Noch mal zusammen fassend erklärt: Jedesmal wenn ein Seitenwechsel kommt, soll er eine neue Tabelle erstellen. So dass ich nachher meine 53 Tabellen anstelle einer habe.

Gruß
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 249665

Url: https://administrator.de/contentid/249665

Printed on: April 25, 2024 at 17:04 o'clock

10 Comments
Latest comment
Goto Top
Member: cse
cse Sep 19, 2014 at 12:04:38 (UTC)
Goto Top
malzeit,

warum? (haha)
geht es darum dann beim ausdruck 53 zettel zu haben mit tabellenköpfen?
Member: colinardo
colinardo Sep 19, 2014 updated at 12:17:20 (UTC)
Goto Top
Hallo killtec,
benötigt er das für den Druck ? Also die Spaltenüberschriften lassen sich ja für den Druck auf jeder Seite automatisch wiederholen (Druckoptionen > Seite einrichten > Tab: Blatt "Wiederholungszeilen" ), falls es das ist was er gesucht hat ?!

Falls er es wieder erwarten doch so benötigt, mit VBA sollte das kein Problem darstellen. Kommt dann drauf an ob er mir richtigen Tabellen (Funktion als Tabelle formatieren) arbeitet oder ob die Tabelle nur ein normaler Bereich ist.

Grüße Uwe
Member: cse
cse Sep 19, 2014 at 12:12:48 (UTC)
Goto Top
Zitat von @colinardo:

Hallo killtec,
benötigt er das für den Druck ? Also die Spaltenüberschriften lassen sich ja für den Druck auf jeder Seite
automatisch wiederholen (Druckoptionen), falls es das ist was er gesucht hat ?!

war auch mein Ansatz face-wink
Member: killtec
killtec Sep 19, 2014 at 12:19:24 (UTC)
Goto Top
Hallo zusammen,
gemeint ist nicht der Druck. Es soll jede Seite so "umformatiert" werden, dass aus der jetzt momentan einzigen Tabelle 53 Tabellen entstehen. Trennpunkt wäre der Seitenumbruch.

Gruß
Member: colinardo
Solution colinardo Sep 19, 2014, updated at Sep 22, 2014 at 11:19:50 (UTC)
Goto Top
Zitat von @killtec:
Hallo zusammen,
gemeint ist nicht der Druck. Es soll jede Seite so "umformatiert" werden, dass aus der jetzt momentan einzigen Tabelle
53 Tabellen entstehen. Trennpunkt wäre der Seitenumbruch.
OK, ich habe das jetzt so interpretiert, dass eine lange Tabelle die auf dem ersten Tabellenblatt liegt, anhand der horizontalen Zeilenumbrüche in neue Tabellenblätter aufgesplittet werden soll: split_table_to_worksheets_249665.xlsm
(Im Sheet habe ich mal auf jedem neuen Blatt die Überschriften mit übernommen - lässt sich aber einfach abändern wenn man das nicht möchte)

Sub SplitTableOnHorizontalPageBreaks()
    Dim ws As Worksheet, rngHeaders As Range, rngPBStart As Range, newWS As Worksheet, pbRow As Long, maxCol As Long, maxRow As Long, rngTable As Range, curCell As Range
    'Sheet der Tabelle festlegen  
    Set ws = Worksheets(1)
    'Bereich der Tabelle festlegen  
    Set rngTable = ws.UsedRange
    'maximale Spalte der Tabelle  
    maxCol = rngTable.Cells(1, rngTable.Columns.Count).Column
    'max Zeile der Tabelle  
    maxRow = rngTable.Cells(rngTable.Rows.Count, 1).Row
    'Bereich der Überschriften  
    Set rngHeaders = rngTable.Rows(1)
    
    'letzte Zelle auf dem Sheet selektieren (wegen einem Bug siehe: http://support.microsoft.com/kb/210663/de)  
    ws.Range("IV65536").Select  
    
    ' Für jeden horizontalen PageBreak ...  
    For i = 0 To ws.HPageBreaks.Count - 1
        If i = 0 Then
            'Der Tabellenanfang hat keinen Pagebreak, also nehme die erste Zelle nach den Überschriften als Start für den zu kopierenden Bereich  
            Set rngPBStart = rngTable.Rows(2)
        Else
            Set rngPBStart = ws.HPageBreaks(i).Location
        End If
        If i < ws.HPageBreaks.Count - 1 Then
            'Wenn noch genügend PageBreaks vorhanden sind nehme den nächsten als Begrenzung  
            pbRow = (ws.HPageBreaks(i + 1).Location.Row) - 1
        Else
            'ansonsten nehme den übrig gebliebenen Rest  
            pbRow = maxRow
        End If
        'neues Sheet hinzufügen  
        Set newWS = Worksheets.Add(After:=Sheets(Sheets.Count))
        'Name des neuen Sheets setzen  
        newWS.Name = "Part_" & (i + 1)  
        'Überschriften in das neue Worksheet übernehmen  
        rngHeaders.Copy newWS.Range("A1")  
        'Daten in das neue Sheet kopieren  
        ws.Range(rngPBStart, ws.Cells(pbRow, maxCol)).Copy newWS.Range("A2")  
        
        'Spaltenbreiten anpassen  
        For x = 1 To rngTable.Columns.Count
            newWS.Columns(x).ColumnWidth = rngTable.Columns(x).ColumnWidth
        Next
    Next
    'Startsheet wieder selektieren  
    ws.Select
    ws.Range("A1").Select  
End Sub
Grüße Uwe
Member: killtec
killtec Sep 22, 2014 at 06:00:18 (UTC)
Goto Top
Hi Uwe,
das geht genau in die richtige Richtung.
Habe jetzt nur noch das Problem, dass nur die erste Spalte betrachtet wird. An welcher Ecke muss ich drehen, dass alle vier Spalten mit genommen werden?
Kann man auch irgendwie die Spaltenbreiten mit übernehmen?

Gruß
Member: colinardo
colinardo Sep 22, 2014 at 06:17:22 (UTC)
Goto Top
Zitat von @killtec:

Hi Uwe,
das geht genau in die richtige Richtung.
Habe jetzt nur noch das Problem, dass nur die erste Spalte betrachtet wird. An welcher Ecke muss ich drehen, dass alle vier
Spalten mit genommen werden?
Kann man auch irgendwie die Spaltenbreiten mit übernehmen?

Wie sieht die Tabelle aus ? Haben alle Spalten Überschriften ? Das ermittelt das Script normalerweise automatisch, außer an der Tabelle ist etwas merkwürdiges, oder eine ganz leere Spalte dazwischen.
Das Anpassen der Spaltenbreiten ließe sich auch anpassen.
Member: killtec
killtec Sep 22, 2014 at 06:38:18 (UTC)
Goto Top
Die Tabelle ist so aufgebaut:
1. Zeile(geht über 4 Spalten, die zusammen sind) = Überschrift
2. Zeile = leer
3. Zeile = Text | Text | Text | Text
restlichen Zeilen wie oben. Teilweise leere Zellen, jedoch mit Rand (Gitterlinien).

Gruß
Member: colinardo
colinardo Sep 22, 2014 updated at 07:36:20 (UTC)
Goto Top
OK, Code und Sheet sind angepasst.

Ich hatte noch mit einem ganz fiesen Bug zu kämpfen den ich zufällig hier entdeckt habe:
http://support.microsoft.com/kb/210663/de (ich dachte schon was ist den heute blos los ...diesmal waren die Jungs aus Redmond schuld face-wink )

Grüße Uwe
Member: killtec
killtec Sep 22, 2014 at 11:19:43 (UTC)
Goto Top
Hi Uwe,
habe das noch ein bisschen abgewandelt. Nun kopiert er mir die erste Überschrift nicht rein, aber bei einer Tabelle ist das kein Problem face-smile Der wird manuell kopiert.
Die anderen Sachen kopiert er dann passend.

Sub SplitTableOnHorizontalPageBreaks()
    Dim ws As Worksheet, rngHeaders As Range, rngPBStart As Range, newWS As Worksheet, pbRow As Long, maxCol As Long, maxRow As Long, rngTable As Range, curCell As Range
    'Sheet der Tabelle festlegen  
    Set ws = Worksheets(1)
    'Bereich der Tabelle festlegen  
    Set rngTable = ws.UsedRange
    'maximale Spalte der Tabelle  
    maxCol = rngTable.Cells(1, rngTable.Columns.Count).Column
    'max Zeile der Tabelle  
    maxRow = rngTable.Cells(rngTable.Rows.Count, 1).Row
    'Bereich der Überschriften  
    Set rngHeaders = rngTable.Rows(1)
    
    'letzte Zelle auf dem Sheet selektieren (wegen einem Bug siehe: http://support.microsoft.com/kb/210663/de)  
    ws.Range("IV65536").Select  
    Z = 1
    ' Für jeden horizontalen PageBreak ...  
    For i = 0 To ws.HPageBreaks.Count - 1
        If i = 0 Then
            'Der Tabellenanfang hat keinen Pagebreak, also nehme die erste Zelle nach den Überschriften als Start für den zu kopierenden Bereich  
            Set rngPBStart = rngTable.Rows(2)
        Else
            Set rngPBStart = ws.HPageBreaks(i).Location
        End If
        If i < ws.HPageBreaks.Count - 1 Then
            'Wenn noch genügend PageBreaks vorhanden sind nehme den nächsten als Begrenzung  
            pbRow = (ws.HPageBreaks(i + 1).Location.Row) - 1
        Else
            'ansonsten nehme den übrig gebliebenen Rest  
            pbRow = maxRow
        End If
        'neues Sheet hinzufügen  
        Set newWS = Worksheets.Add(After:=Sheets(Sheets.Count))
        'Name des neuen Sheets setzen  
        newWS.Name = "Part_" & (i + 1)  
        'Überschriften in das neue Worksheet übernehmen  
        If Z = 1 Then
        
            rngHeaders.Copy newWS.Range("A1")  
            Z = 2
        End If
        'Daten in das neue Sheet kopieren  
        If Z = 2 Then
            ws.Range(rngPBStart, ws.Cells(pbRow, maxCol)).Copy newWS.Range("A1")  
        Else
            ws.Range(rngPBStart, ws.Cells(pbRow, maxCol)).Copy newWS.Range("A2")  
        End If
        'Spaltenbreiten anpassen  
        For x = 1 To rngTable.Columns.Count
            newWS.Columns(x).ColumnWidth = rngTable.Columns(x).ColumnWidth
        Next
    Next
    'Startsheet wieder selektieren  
    ws.Select
    ws.Range("A1").Select  
End Sub


Danke dir face-smile

Gruß
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 Comments