Sub
verteilen()
Dim
sh
As
Worksheet
Dim
i&, maxrow&, rng
As
Range
Const
TEILER = 50000
Set
sh = ActiveSheet
Set
rng = Intersect(sh.UsedRange, sh.Rows(1))
maxrow = sh.UsedRange.Rows.Count
For
i = 2
To
maxrow
With
Worksheets.Add(after:=Worksheets(Worksheets.Count))
.Name = i - 1 &
" - "
& i - 2 + TEILER
rng.Copy .Cells(1, 1)
sh.Cells(i, 1).Resize(TEILER, rng.Columns.Count).Copy .Cells(2, 1)
i = i + TEILER - 1
Application.CutCopyMode =
False
If
i > maxrow
Then
Exit
Sub
End
With
Next
End
Sub