Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Seitenumbruch in Excel soll neue Tabelle sein

Frage Microsoft Microsoft Office

Mitglied: killtec

killtec (Level 3) - Jetzt verbinden

19.09.2014, aktualisiert 22.09.2014, 2234 Aufrufe, 10 Kommentare

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ß
Mitglied: cse
19.09.2014 um 14:04 Uhr
malzeit,

warum? (haha)
geht es darum dann beim ausdruck 53 zettel zu haben mit tabellenköpfen?
Bitte warten ..
Mitglied: colinardo
19.09.2014, aktualisiert um 14:17 Uhr
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
Bitte warten ..
Mitglied: cse
19.09.2014 um 14:12 Uhr
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
Bitte warten ..
Mitglied: killtec
19.09.2014 um 14:19 Uhr
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ß
Bitte warten ..
Mitglied: colinardo
LÖSUNG 19.09.2014, aktualisiert 22.09.2014
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)

01.
Sub SplitTableOnHorizontalPageBreaks() 
02.
    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 
03.
    'Sheet der Tabelle festlegen 
04.
    Set ws = Worksheets(1) 
05.
    'Bereich der Tabelle festlegen 
06.
    Set rngTable = ws.UsedRange 
07.
    'maximale Spalte der Tabelle 
08.
    maxCol = rngTable.Cells(1, rngTable.Columns.Count).Column 
09.
    'max Zeile der Tabelle 
10.
    maxRow = rngTable.Cells(rngTable.Rows.Count, 1).Row 
11.
    'Bereich der Überschriften 
12.
    Set rngHeaders = rngTable.Rows(1) 
13.
     
14.
    'letzte Zelle auf dem Sheet selektieren (wegen einem Bug siehe: http://support.microsoft.com/kb/210663/de) 
15.
    ws.Range("IV65536").Select 
16.
     
17.
    ' Für jeden horizontalen PageBreak ... 
18.
    For i = 0 To ws.HPageBreaks.Count - 1 
19.
        If i = 0 Then 
20.
            'Der Tabellenanfang hat keinen Pagebreak, also nehme die erste Zelle nach den Überschriften als Start für den zu kopierenden Bereich 
21.
            Set rngPBStart = rngTable.Rows(2) 
22.
        Else 
23.
            Set rngPBStart = ws.HPageBreaks(i).Location 
24.
        End If 
25.
        If i < ws.HPageBreaks.Count - 1 Then 
26.
            'Wenn noch genügend PageBreaks vorhanden sind nehme den nächsten als Begrenzung 
27.
            pbRow = (ws.HPageBreaks(i + 1).Location.Row) - 1 
28.
        Else 
29.
            'ansonsten nehme den übrig gebliebenen Rest 
30.
            pbRow = maxRow 
31.
        End If 
32.
        'neues Sheet hinzufügen 
33.
        Set newWS = Worksheets.Add(After:=Sheets(Sheets.Count)) 
34.
        'Name des neuen Sheets setzen 
35.
        newWS.Name = "Part_" & (i + 1) 
36.
        'Überschriften in das neue Worksheet übernehmen 
37.
        rngHeaders.Copy newWS.Range("A1") 
38.
        'Daten in das neue Sheet kopieren 
39.
        ws.Range(rngPBStart, ws.Cells(pbRow, maxCol)).Copy newWS.Range("A2") 
40.
         
41.
        'Spaltenbreiten anpassen 
42.
        For x = 1 To rngTable.Columns.Count 
43.
            newWS.Columns(x).ColumnWidth = rngTable.Columns(x).ColumnWidth 
44.
        Next 
45.
    Next 
46.
    'Startsheet wieder selektieren 
47.
    ws.Select 
48.
    ws.Range("A1").Select 
49.
End Sub
Grüße Uwe
Bitte warten ..
Mitglied: killtec
22.09.2014 um 08:00 Uhr
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ß
Bitte warten ..
Mitglied: colinardo
22.09.2014 um 08:17 Uhr
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.
Bitte warten ..
Mitglied: killtec
22.09.2014 um 08:38 Uhr
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ß
Bitte warten ..
Mitglied: colinardo
22.09.2014, aktualisiert um 09:36 Uhr
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 )

Grüße Uwe
Bitte warten ..
Mitglied: killtec
22.09.2014 um 13:19 Uhr
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 Der wird manuell kopiert.
Die anderen Sachen kopiert er dann passend.

01.
Sub SplitTableOnHorizontalPageBreaks() 
02.
    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 
03.
    'Sheet der Tabelle festlegen 
04.
    Set ws = Worksheets(1) 
05.
    'Bereich der Tabelle festlegen 
06.
    Set rngTable = ws.UsedRange 
07.
    'maximale Spalte der Tabelle 
08.
    maxCol = rngTable.Cells(1, rngTable.Columns.Count).Column 
09.
    'max Zeile der Tabelle 
10.
    maxRow = rngTable.Cells(rngTable.Rows.Count, 1).Row 
11.
    'Bereich der Überschriften 
12.
    Set rngHeaders = rngTable.Rows(1) 
13.
     
14.
    'letzte Zelle auf dem Sheet selektieren (wegen einem Bug siehe: http://support.microsoft.com/kb/210663/de) 
15.
    ws.Range("IV65536").Select 
16.
    Z = 1 
17.
    ' Für jeden horizontalen PageBreak ... 
18.
    For i = 0 To ws.HPageBreaks.Count - 1 
19.
        If i = 0 Then 
20.
            'Der Tabellenanfang hat keinen Pagebreak, also nehme die erste Zelle nach den Überschriften als Start für den zu kopierenden Bereich 
21.
            Set rngPBStart = rngTable.Rows(2) 
22.
        Else 
23.
            Set rngPBStart = ws.HPageBreaks(i).Location 
24.
        End If 
25.
        If i < ws.HPageBreaks.Count - 1 Then 
26.
            'Wenn noch genügend PageBreaks vorhanden sind nehme den nächsten als Begrenzung 
27.
            pbRow = (ws.HPageBreaks(i + 1).Location.Row) - 1 
28.
        Else 
29.
            'ansonsten nehme den übrig gebliebenen Rest 
30.
            pbRow = maxRow 
31.
        End If 
32.
        'neues Sheet hinzufügen 
33.
        Set newWS = Worksheets.Add(After:=Sheets(Sheets.Count)) 
34.
        'Name des neuen Sheets setzen 
35.
        newWS.Name = "Part_" & (i + 1) 
36.
        'Überschriften in das neue Worksheet übernehmen 
37.
        If Z = 1 Then 
38.
         
39.
            rngHeaders.Copy newWS.Range("A1") 
40.
            Z = 2 
41.
        End If 
42.
        'Daten in das neue Sheet kopieren 
43.
        If Z = 2 Then 
44.
            ws.Range(rngPBStart, ws.Cells(pbRow, maxCol)).Copy newWS.Range("A1") 
45.
        Else 
46.
            ws.Range(rngPBStart, ws.Cells(pbRow, maxCol)).Copy newWS.Range("A2") 
47.
        End If 
48.
        'Spaltenbreiten anpassen 
49.
        For x = 1 To rngTable.Columns.Count 
50.
            newWS.Columns(x).ColumnWidth = rngTable.Columns(x).ColumnWidth 
51.
        Next 
52.
    Next 
53.
    'Startsheet wieder selektieren 
54.
    ws.Select 
55.
    ws.Range("A1").Select 
56.
End Sub

Danke dir

Gruß
Bitte warten ..
Neuester Wissensbeitrag
CPU, RAM, Mainboards

Angetestet: PC Engines APU 3a2 im Rack-Gehäuse

Erfahrungsbericht von ashnod zum Thema CPU, RAM, Mainboards ...

Ähnliche Inhalte
Microsoft Office
Excel 2010 - Tabelle mit mehreren Makros? (2)

Frage von Norderney95 zum Thema Microsoft Office ...

VB for Applications
Bestimmte Daten aus eine CSV-Datei in eine Excel-Tabelle importieren (2)

Frage von MariaElena zum Thema VB for Applications ...

Microsoft Office
EXCEL VBA Termindaten aus Tabelle Filtern

Frage von t3jxbus zum Thema Microsoft Office ...

Heiß diskutierte Inhalte
Windows Server
DHCP Server switchen (25)

Frage von M.Marz zum Thema Windows Server ...

Grafikkarten & Monitore
Win 10 Grafikkarte Crash von Software? (13)

Frage von Marabunta zum Thema Grafikkarten & Monitore ...

Windows Server
Mailserver auf Windows Server 2012 (8)

Frage von StefanT81 zum Thema Windows Server ...

Backup
Clients als Server missbrauchen? (8)

Frage von 1410640014 zum Thema Backup ...