Thanks Chris -
I'm getting an error at
ActiveSheet.Range("a1").Paste

Any ideas?


"chris: one Boo-boo" wrote in message
...
use this:
Sub SplitShts()
Dim MySheet As Worksheet, MyRange As Range
Dim x As Single, y As Integer, z As Single, Mv As Integer
Set MySheet = ActiveSheet
x = Cells(Rows.Count, "A").End(xlUp).Row
If x <= 20000 Then Exit Sub
y = Fix(x / 20000)
z = x Mod 20000 << MOVED UP
If y = 1 Then GoTo ModOnly:
y = y - 1
For Mv = 1 To y
Set MyRange = Rows(1).Offset(20000).Resize(20000)
MyRange.Cut
Sheets.Add
ActiveSheet.Range("a1").Paste
MySheet.Activate
MyRange.EntireRow.Delete Shift:=xlShiftUp
Next
ModOnly:
If z 0 Then
Set MyRange = Rows(1).Offset(20000).Resize(z)
MyRange.Cut
Sheets.Add
ActiveSheet.Range("a1").Paste
MySheet.Activate
MyRange.EntireRow.Delete Shift:=xlShiftUp
End If
End Sub


----- chris wrote: -----

try this: Do a test on dummy workbook first,since it deletes Rows.

Sub SplitShts()
Dim MySheet As Worksheet, MyRange As Range
Dim x As Single, y As Integer, z As Single, Mv As Integer
Set MySheet = ActiveSheet
x = Cells(Rows.Count, "A").End(xlUp).Row
If x <= 20000 Then Exit Sub
y = Fix(x / 20000)
If y = 1 Then GoTo ModOnly:
y = y - 1
z = x Mod 20000
For Mv = 1 To y
Set MyRange = Rows(1).Offset(20000).Resize(20000)
MyRange.Cut
Sheets.Add
ActiveSheet.Range("a1").Paste
MySheet.Activate
MyRange.EntireRow.Delete Shift:=xlShiftUp
Next
ModOnly:
If z 0 Then
Set MyRange = Rows(1).Offset(20000).Resize(z)
MyRange.Cut
Sheets.Add
ActiveSheet.Range("a1").Paste
MySheet.Activate
MyRange.EntireRow.Delete Shift:=xlShiftUp
End If
End Sub
----- JayL wrote: -----

All,
Looking for a way to take a worksheet that is 65000+ rows and
split it into
20000 row worksheets. Adding a new worksheet and moving the rows
over ??
Ideally, I would like to go to row 20k and back up to the 1st
cell in Col B
that is 1, cut form that row down to a new sheet?

Is this possible?

-Jay