Split a worksheet?

[JayL]

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

 

[Guest]

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 Sub
----- JayL wrote: ----

All
Looking for a way to take a worksheet that is 65000+ rows and split it int
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
that is >1, cut form that row down to a new sheet

Is this possible

-Ja

 

[Guest]

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 Sub


----- 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 Sub
----- JayL wrote: ----

All
Looking for a way to take a worksheet that is 65000+ rows and split it int
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
that is >1, cut form that row down to a new sheet

Is this possible

-Ja

 

[JayL]

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

Any ideas?

 

[Tom Ogilvy]

When you add the sheet, it clears the clipboard, so there is nothing to
paste.

As a general rule, you should have no actions between copy and paste
commands.

modify your code to do the copy just before the paste (after you have added
the sheet).

 

[Guest]

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

 

[Guest]

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 <= 2 Then Exit Sub
y = Fix(x / 2)
z = x Mod 2
If y = 1 Then GoTo ModOnly:
y = y - 1
For Mv = 1 To y
Set MyRange = Rows(1).Offset(20000).Resize(20000)
Sheets.Add
MyRange.Copy Destination:=ActiveSheet.Range("a1")
MySheet.Activate
MyRange.EntireRow.Delete Shift:=xlShiftUp
Next
ModOnly:
If z > 0 Then
Set MyRange = Rows(1).Offset(20000).Resize(z)
Sheets.Add
MyRange.Copy Destination:=ActiveSheet.Range("a1")
MySheet.Activate
MyRange.EntireRow.Delete Shift:=xlShiftUp
End If
End Sub