Copy klappt, Cut nicht
04.08.2005 14:59:11
Reinhard
zur beantwortung einer Anfrage hier hatte ich nachfolgenden Code entwickelt.
So wie er ist, bleibt ab 3ter Aufteilung also ab Spalte E immer die oberste Zelle leer und unten ist eine Zeile zuviel dran.
Benutze ich anstelle von Cut aber Copy so funktioniert er problemlos.
Gruß
Reinhard
Option Explicit
Sub tt()
Call Füllen
Dim sp As Integer, zei As Integer, n As Long, lae As Long, anz As Long
sp = 5 'Anzahl der Aufteilungen, maximal 127
zei = 80 'Anzahl Zeilen pro Druckblatt
lae = Cells(65536, 1).End(xlUp).Row
anz = Int(lae / sp)
While anz / zei <> Int(anz / zei)
anz = anz - 1
Wend
For n = 1 To sp - 1
Range(Cells(n * anz + 1, 1), Cells((n + 1) * anz + 1, 2)).Cut Destination:=Cells(1, n * 2 + 1)
Next n
End Sub
Sub Füllen()
Range("C1:IV65536").Clear
Range("A1").FormulaR1C1 = "1"
Range("A1").AutoFill Destination:=Range("A1:A50000"), Type:=xlFillSeries
Range("B50000").FormulaR1C1 = "1"
Range("B50000").AutoFill Destination:=Range("B1:B50000"), Type:=xlFillSeries
Range("A1").Select
End Sub