Sub SplitShts()
Dim MySheet As Worksheet, MyRange As Rang
Dim x As Single, y As Integer, z As Single, Mv As Intege
Set MySheet = ActiveShee
x = Cells(Rows.Count, "A").End(xlUp).Ro
If x <= 20000 Then Exit Su
y = Fix(x / 20000
z = x Mod 2000
If y = 1 Then GoTo ModOnly
y = y -
For Mv = 1 To
Set MyRange = Rows(1).Offset(20000).Resize(20000
Sheets.Ad
MySheet.MyRange.Cop
ActiveSheet.Range("a1").Past
MySheet.Activat
MySheet.MyRange.EntireRow.Delete Shift:=xlShiftU
Nex
ModOnly
If z 0 The
Set MyRange = Rows(1).Offset(20000).Resize(z
Sheets.Ad
MySheet.MyRange.Cop
ActiveSheet.Range("a1").Past
MySheet.Activat
MySheet.MyRange.EntireRow.Delete Shift:=xlShiftU
End I
End Sub
----- JayL wrote: ----

Thanks Chris
I'm getting an error a
ActiveSheet.Range("a1").Past

Any ideas


"chris: one Boo-boo" wrote in messag
..
use this
Sub SplitShts(
Dim MySheet As Worksheet, MyRange As Rang
Dim x As Single, y As Integer, z As Single, Mv As Intege
Set MySheet = ActiveShee
x = Cells(Rows.Count, "A").End(xlUp).Ro
If x <= 20000 Then Exit Su
y = Fix(x / 20000
z = x Mod 20000 << MOVED U
If y = 1 Then GoTo ModOnly
y = y -
For Mv = 1 To
Set MyRange = Rows(1).Offset(20000).Resize(20000
MyRange.Cu
Sheets.Ad
ActiveSheet.Range("a1").Past
MySheet.Activat
MyRange.EntireRow.Delete Shift:=xlShiftU
Nex
ModOnly
If z 0 The
Set MyRange = Rows(1).Offset(20000).Resize(z
MyRange.Cu
Sheets.Ad
ActiveSheet.Range("a1").Past
MySheet.Activat
MyRange.EntireRow.Delete Shift:=xlShiftU
End I
End Su
----- chris wrote: ----
try this: Do a test on dummy workbook first,since it deletes Rows
Sub SplitShts(
Dim MySheet As Worksheet, MyRange As Rang
Dim x As Single, y As Integer, z As Single, Mv As Intege
Set MySheet = ActiveShee
x = Cells(Rows.Count, "A").End(xlUp).Ro
If x <= 20000 Then Exit Su
y = Fix(x / 20000
If y = 1 Then GoTo ModOnly
y = y -
z = x Mod 2000
For Mv = 1 To
Set MyRange = Rows(1).Offset(20000).Resize(20000
MyRange.Cu
Sheets.Ad
ActiveSheet.Range("a1").Past
MySheet.Activat
MyRange.EntireRow.Delete Shift:=xlShiftU
Nex
ModOnly
If z 0 The
Set MyRange = Rows(1).Offset(20000).Resize(z
MyRange.Cu
Sheets.Ad
ActiveSheet.Range("a1").Past
MySheet.Activat
MyRange.EntireRow.Delete Shift:=xlShiftU
End I
End Su
----- JayL wrote: ----
All
Looking for a way to take a worksheet that is 65000+ rows an
split it int
20000 row worksheets. Adding a new worksheet and moving the row
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