Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
708to712
708to712
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Drucken

Drucken
14.12.2005 19:21:37
Jürgen
Hallo zusammen,
folgendes Problem. Habe nur in Spalte A ca 1000 Einträge. Wenn ich das ausdrucke, liegen ne Menge Zettel im Drucker. Gibt es eine Möglichkeit, diese Einträge nebeneinander in die Spalten B, C, D usw zu bekommen, so dass die Einträge nicht länger als bis Zeile 56 sind?
Danke für einen Tipp, Gruß Jürgen

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Drucken
14.12.2005 20:43:21
Jürgen
Hallo zusammen,
vielleicht geht das ja nur mittels VBA. Mit dieser Zeile markiere ich leider auch den Bereich oberhalb A56. Wie kann ich denn nur den Bereich A57 bis zur letzten Zeile markieren?
Range("A57").Select
ActiveCell.CurrentRegion.Select
Vielleicht kann ich mir irgendwie etwas in VBA basteln.
Danke im voraus, Gruß Jürgen
AW: Drucken
14.12.2005 20:50:52
Reinhard
Hi Jürgen,
noch 2 macken, läuft nur wenn Tabelle2 sichtbar ist, sonst Anwendungsfehler. Dann schlimmer, Ergebnis ist so als wenn man A nach B,C,D kopiert.
Ich muss jetzt weg, teste es mal im VB-Editor mit F8 und fahre mit der Maus über die Variablen oberhalb der gelben Zeile dann siehst du die Werte und kannst den Fehler eingrenzen.
Ich habe Frage auf noch ofen gestellt, evtl hilft ja ein anderer weiter.
Option Explicit
Sub tt()
Dim anz, ws2, druzei, n, nn, sp, poszei, Bloecke
sp = 5 'soll 5 Spalten maximal breit sein
druzei = 56 'anzahl Druckzeilen
poszei = 1 'zeilenposition in Tab1
Set ws2 = Worksheets("Tabelle2")
ws2.Activate
With Worksheets("Tabelle1")
anz = .Range("A65536").End(xlUp).Row 'Zeilenanzahl
Bloecke = Int((.Range("A65536").End(xlUp).Row - 1) / druzei) + 1 'Anzahl 56er Blöcke
.Range("A1:A" & anz).Copy Destination:=ws2.Range("A1")
For n = 0 To Bloecke - 1
For nn = 1 To sp
ws2.Range(Cells(n * 56 + 1, 1), Cells(n * 56 + 56, 1)).Copy Destination:=.Cells(poszei, nn)
Next nn
poszei = poszei + 56
Next n
End With
End Sub

Gruß
Reinhard
ps:Das Forum lebt auch von Rückmeldungen
Anzeige
AW: Drucken
14.12.2005 21:03:59
Jürgen
Hallo Reinhard,
danke für die schnelle Antwort. Ich werde es testen und Bescheid geben.
Danke und Gruß Jürgen
AW: Drucken
14.12.2005 22:50:39
Matthias
Hallo Jürgen,
mein Vorschlag:

Sub Aufbereiten()
Const sp_max = 7 'Anzahl der zu erzeugenden Spalten
Dim z1 As Long, z2 As Long
Dim sp As Integer
Dim seite As Integer, ze_seite As Long
Dim Anz As Integer
Dim rng As Range
seite = 0
ActiveSheet.Copy After:=ActiveSheet
ActiveWindow.View = xlPageBreakPreview
On Error Resume Next
Do
Anz = ActiveSheet.HPageBreaks.Count
If Anz < seite + 1 Then Exit Do
z1 = ActiveSheet.HPageBreaks(seite + 1).Location.Row
If Err.Number > 0 Then Exit Do
Err.Clear
z2 = ActiveSheet.HPageBreaks(seite + 2).Location.Row - 1
If Err.Number > 0 Then
z2 = Cells(Rows.Count, 1).End(xlUp).Row
End If
Err.Clear
If seite = 0 Then
ze_seite = 1
Else
ze_seite = ActiveSheet.HPageBreaks(seite).Location.Row
End If
sp = Cells(ze_seite, Columns.Count).End(xlToLeft).Column + 1
Debug.Print z1, z2, sp, ze_seite
Set rng = Range(Cells(z1, 1), Cells(z2, 1))
rng.Copy Destination:=Cells(ze_seite, sp)
rng.EntireRow.Delete
If sp = sp_max Then
seite = seite + 1
End If
Loop Until 1 = 2
ActiveWindow.View = xlNormalView
MsgBox "Fertig!"
End Sub

Der Code braucht leider Fehlerabfangroutinen, sonst erscheinen am Ende des Vorgangs immer mal wieder Laufzeitfehler. Wahrscheinlich, weil das Ermitteln der Seitenumbrüche nach dem Löschen von Zeilen langsamer geht als der Code. Genau weiß ich es aber auch nicht.
Gruß Matthias
Anzeige
AW: Drucken
15.12.2005 20:26:12
Jürgen
Hallo Reinhard, hallo Matthias,
danke für Eure Hilfe. Matthias, deine Antwort hatte ich gestern leider nicht mehr gelesen, hatte schon den Rechner aus. Gerade hatte ich mir selber noch mal Gedanken gemacht und dann erst hier mal im Forum reingeschaut. Ich habe nun ebenfalls ne Lösung, mit der ich leben kann. Anbei mal mein Code. Wie oft die Schleife laufen soll, muss ich mal im Büro ausprobieren.
Option Explicit
Public

Sub Splitttest()
Dim intI As Integer
intI = 1
With Worksheets("Tabelle1")
Do Until intI = 3
.Cells(57, intI).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Cut
intI = intI + 1
.Cells(1, intI).Select
ActiveSheet.Paste
Loop
End With
End Sub

Nochmals vielen Dank für eure Hilfe.
Gruß Jürgen
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige