|
Split a worksheet?
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 |
Split a worksheet?
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 |
Split a worksheet?
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 |
Split a worksheet?
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 |
Split a worksheet?
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). -- Regards, Tom Ogilvy "JayL" wrote in message ... 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 |
Split a worksheet?
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 |
Split a worksheet?
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 |
| All times are GMT +1. The time now is 06:37 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com