Makro ändern, aber wie?
09.02.2008 20:19:00
Torsten
Habe endlich ein Makro für mei Problem gefunden, doch wie kann ich die Spaltengröße verändern, oder auf optimale Breite bringen?
Kann ich eine bestimmte Adresse als Ziel angeben?
Wäre dankbar für Hilfe.
MFG Torsten
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("Test")
iStartQ = 2 'Startzeile in Quelle
iSpaltenQ = 9 '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 = 10 '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