Supportnet / Forum / Tabellenkalkulation
Daten sortieren
Frage
Hallo
ich sammele alle Arten von Tipps, die in den versch. Zeitschriften abgedruckt werden. Die klebe ich wahllos auf DIN A4 Seiten (die dann fortlaufend nummeriert werden) und hefte sie dann ab. Auf diese Art habe ich bereits ein kleines Nachschlagewerk. Nun muss ich natürlich hierfür auch ein Inhaltsverzeichnis anlegen. Das habe ich mir mit Excel erstellt. Und zwar so, dass ich jeweils ein Schlagwort und die entsprechende Seite aufliste und sortieren lasse. Und nun kommt mein Problem. Wenn auf eine Seite ca. 50 Zeilen gehen, dann werden es über 20 Seiten. Nun habe ich nach dem Sortiervorgang 50 Zeilen genommen, kopiert und in einer separaten Datei so einfügt, dass 3 Spalten nebeneinander auf eine Seite passen. Gibt es eine Möglichkeit, Excel so einzustellen, dass der Sortiervorgang so abläuft, dass bei A beginnend, die ersten 50 Zeilen in der ersten Spalte enden die zweiten 50 rechts daneben und die weiteren 50 wieder rechts daneben erscheinen? Und das immer so weiter bis zum Ende der Aufstellung. Mein System ist nämlich ziemlich arbeitsaufwändig.
Schönen Dank im Voraus.
Gruß Ted
Antwort 1 von DukeNT
Hi Ted,
angenommen deine Übersicht ist Vorsortiert in der ersten Tabelle in Spalte A. Mit folgendem Code wird die Übersicht in das zweite Tabellenblatt in 50er Blöcken kopiert.
Drücke Alt+F11 - Einfügen - Modul
Kopiere diesen Code in das Modul.
Sub sortieren()
Application.ScreenUpdating = False
lz = Sheets(1).[A65536].End(xlUp).Row
b = 1
c = 1
For a = 1 To lz
Sheets(2).Cells(b, c).Value = Sheets(1).Cells(a, 1).Value
b = b + 1
If b = 51 Then b = 1: c = c + 1
Next a
Application.ScreenUpdating = True
End Sub
Makro ausführen und Voila.
Gruß Niels
angenommen deine Übersicht ist Vorsortiert in der ersten Tabelle in Spalte A. Mit folgendem Code wird die Übersicht in das zweite Tabellenblatt in 50er Blöcken kopiert.
Drücke Alt+F11 - Einfügen - Modul
Kopiere diesen Code in das Modul.
Sub sortieren()
Application.ScreenUpdating = False
lz = Sheets(1).[A65536].End(xlUp).Row
b = 1
c = 1
For a = 1 To lz
Sheets(2).Cells(b, c).Value = Sheets(1).Cells(a, 1).Value
b = b + 1
If b = 51 Then b = 1: c = c + 1
Next a
Application.ScreenUpdating = True
End Sub
Makro ausführen und Voila.
Gruß Niels

