kleine ? Makro Änderung

Forumthread: kleine ? Makro Änderung

15.07.2007 11:39:00

michael

Herzlichen Gruß ins Forum
Ich habe ZWEI Dateien
Datei Liste
Datei Ziel
Die Datei Liste besteht aus 4 Spalten A-D ( Hochformat )
Die Datei Ziel kann aber 2 mal 4 Spalten aufnehmen (nebeneinander)
also A-D E leerund F-I.
Die Liste hat z.B.110 Zeilen derzeit Kopiere ich in die Datei Ziel 55 Zeilen nach A-D
und 55 Zeilen nach F-I (mühsam ernährt sich das Eichhörnchen)
Das war meine Frage ans Forum !!!!!!!!!!!
=====================================================
Dank Forumshilfe habe ich dieses Makro erhaltenfunktioniert einwandfrei.aber
ich bin erst nach einiger Zeit draufgekommen das wenn ich weniger als 110 Zeilen habe
z.B. 80 , diese Zeilen auf 2x40 aufgeteilt werden.
In der ersten Spalte , also A-D sollen IMMER 55 Zeilen ausgefüllt werden
und der REST , in dem Fall 25 Zeilen nach F-I.
Kann mir bitte jemand den Code ändern .
Danke und kühlender Gruß---bei mir hats schon 32 Grad
der kleine michael
====================================================


Sub umsetzen()
QuellBook = ActiveWorkbook.Name
quellSheet = "Liste2"
'Ziel
Workbooks.Add
ZielBook = ActiveWorkbook.Name
With Workbooks(QuellBook).Sheets(quellSheet)
lzeile = Round(.Cells(65536, 1).End(xlUp).Row / 2, 0)
For zeile = 2 To lzeile
For y = 1 To 4
Worksheets(1).Cells(zeile, y) = .Cells(zeile, y)
Worksheets(1).Cells(zeile, y + 5) = .Cells(zeile + lzeile - 1, y)
Next y
Next zeile
End With
End Sub

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: kleine ? Makro Änderung

15.07.2007 13:26:00

Gerd
AW: kleine ? Makro Änderung

15.07.2007 14:05:49

fcs
AW: Makro Änderung-riesig

15.07.2007 15:56:00

michael

AW: kleine ? Makro Änderung

15.07.2007 13:26:00

Gerd

Hallo Michael,
Ist 110 die maximale Zeilenanzahl im Quellsheet?
Falls nein, wie soll auf die beiden Bereiche im Ziel-Blatt verteilt werden, wenn es mehr als 110 gefüllte Zeilen Quellsheet sind ?
Gruß Gerd

AW: kleine ? Makro Änderung

15.07.2007 14:05:49

fcs

Hallo Michael,
Gerd's Frage ist berechtigt.
Hier eine Lösung, die ich zum Papiesparen verwende, angepasst auf deine Zeilen/Spaltenwerte.
Den Part zum Einrichten der Drucktitelzeilen kannst du ja weglassen, wenn du ihn nicht beauchst.
Die Datenausgabe ist dabei auf den Seiten fortlaufend, d.h. Seite 1 links, Seite 1 rechts, Seite2 links, Seite 2 rechts usw.
Gruß
Franz


Sub umsetzen()
Dim wbQuelle As Workbook, wksQuelle As Worksheet, iJ%
Dim iZeileQ%, iLZeile%, iStartQ, iSpaltenQ
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim iZeileZ%, iSpalteZ%, iSpalteZ1%, iSpalteZ2%, iZeilenSeite%, iZeile1Seite%, iTitelZ%
'Quelle
Set wbQuelle = ActiveWorkbook
Set wksQuelle = wbQuelle.Worksheets("Liste2")
iStartQ = 2 'Startzeile in Quelle
iSpaltenQ = 4 'Anzahl Spalten in Quelle
'Ziel
Set wbZiel = Workbooks.Add
Set wksZiel = wbZiel.Worksheets(1)
iZeilenSeite = 55 'Zeilen pro Seite in Zieltabelle
iTitelZ = 1 'Anzahl Titelzeilen
iSpalteZ1 = 0 'Spaltennummer der Spalte links der Linken Kolonne in Zieltabelle
iSpalteZ2 = 5 'Spaltennummer der Spalte links der rechten Kolonne in Zieltabelle
'Titelzeile(n)
With wksZiel
'Text aus Titelzeilen Quelle übernehmen
.Range(.Cells(1, iSpalteZ1 + 1), .Cells(iTitelZ, iSpalteZ1 + iSpaltenQ)).Value _
= wksQuelle.Range(wksQuelle.Cells(1, 1), wksQuelle.Cells(iTitelZ, iSpaltenQ)).Value
.Range(.Cells(1, iSpalteZ2 + 1), .Cells(iTitelZ, iSpalteZ2 + iSpaltenQ)).Value _
= wksQuelle.Range(wksQuelle.Cells(1, 1), wksQuelle.Cells(iTitelZ, iSpaltenQ)).Value
'als Druck-Wiederholungszeilen einstellen
.PageSetup.PrintTitleRows = .Range(.Rows(1), .Rows(iTitelZ)).Address
End With
iZeile1Seite = iTitelZ + 1 '1. Zeile mit Daten in Zieltabelle
With wksQuelle
iLZeile = .Cells(.Rows.Count, 1).End(xlUp).Row 'Letzte Zeile in Quelltabelle
iSpalteZ = iSpalteZ1
iZeileZ = iTitelZ + 1
For iZeileQ = iStartQ To iLZeile
If iZeileZ = iZeile1Seite + (iZeilenSeite - iTitelZ) Then 'Max Zeilenzahl pro Seite
If iSpalteZ = iSpalteZ2 Then
'auf nächster Seite wieder links beginnen
iZeile1Seite = iZeile1Seite + (iZeilenSeite - iTitelZ)
iZeileZ = iZeile1Seite
iSpalteZ = iSpalteZ1
Else
'in rechter Kolonne am Seitenanfag weitermachen
iZeileZ = iZeile1Seite
iSpalteZ = iSpalteZ2
End If
End If
For iJ = 1 To iSpaltenQ
wksZiel.Cells(iZeileZ, iSpalteZ + iJ) = .Cells(iZeileQ, iJ)
Next iJ
iZeileZ = iZeileZ + 1
Next iZeileQ
End With
End Sub

AW: Makro Änderung-riesig

15.07.2007 15:56:00

michael

Bescheidenerweise wollte ich für mein Fahrrad einen Gang dazu haben,
Jetzt hab ich einen Mercedes bekommen ,den ich mir nicht mühsam erarbeiten musste.
@Gerd . Danke für deine Fragenstellung nur wollte ich (wie im Forum oft gelesen)nicht
einen ganzen Fragenkatalog erstellen und versuchen selber weiter zu wurschteln.
@Franz . Danke für den Mercedes er ist das Endprodukt das ich erreichen wollte.
Ziehe dir dafür bitte 10 Grad der derzeitigen Temperatur ab (grins)
Herzliches Danke.
der kleine michael

Beliebteste Forumthreads (12 Monate)

Forumthread: kleine ? Makro Änderung

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread