PC Review


Reply
Thread Tools Rate Thread

How could I split a spreadsheet containing 600 rows, so there's 100rows in each new workbook

 
 
John
Guest
Posts: n/a
 
      25th Jan 2012
Suppose a spreadsheet contains 600 rows of data.

I'd love to be split this into separate workbooks containing 100 rows
each.
- I'd like the name format to be gubbins1.xls, gubbins2.xls,
gubbins3.xls, gubbins4.xls, gubbins5.xls, gubbins6.xls

- I'd like each workbook to keep row 1 of the original file (because
it's a header row)


------

Notes
- I really want the output to be Excel spreadsheets (XLS etc), rather
than CSV
- Thanks for taking the time to read this!

 
Reply With Quote
 
 
 
 
isabelle
Guest
Posts: n/a
 
      25th Jan 2012
hi John,

Sub Macro1()
Dim wks1 As Workbook, wks2 As Workbook
Dim x As Integer, i As Integer
Dim pth As String
pth = "C:\temp" 'adapt path
cSheets = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wks1 = ActiveWorkbook
Application.ScreenUpdating = False

For i = 2 To 601 Step 100
x = x + 1
Set wks2 = Workbooks.Add
wks1.ActiveSheet.Rows(1).Copy wks2.ActiveSheet.Rows(1)
wks1.ActiveSheet.Rows(i & ":" & i + 99).Copy wks2.ActiveSheet.Rows(2)
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:=pth & "\gubbins" & x & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
Next

Application.SheetsInNewWorkbook = cSheets
Set wks1 = Nothing
Set wks2 = Nothing
Application.ScreenUpdating = True
End Sub



--
isabelle




Le 2012-01-25 11:50, John a écrit :
> Suppose a spreadsheet contains 600 rows of data.
>
> I'd love to be split this into separate workbooks containing 100 rows
> each.
> - I'd like the name format to be gubbins1.xls, gubbins2.xls,
> gubbins3.xls, gubbins4.xls, gubbins5.xls, gubbins6.xls
>
> - I'd like each workbook to keep row 1 of the original file (because
> it's a header row)
>
>
> ------
>
> Notes
> - I really want the output to be Excel spreadsheets (XLS etc), rather
> than CSV
> - Thanks for taking the time to read this!
>

 
Reply With Quote
 
GS
Guest
Posts: n/a
 
      25th Jan 2012
Isabelle,
I think you mean...

For i = 2 To 502 Step 100

...to create 6 new files as follows:

gubbins1.xls: 2-101
gubbins2.xls: 102-201
gubbins3.xls: 202-301
gubbins4.xls: 302-401
gubbins5.xls: 402-501
gubbins6.xls: 502-601

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


 
Reply With Quote
 
GS
Guest
Posts: n/a
 
      25th Jan 2012
You can have each output end at row increments of 100 by changing your
output range from i + 99 to i + 98, so the resulting files are...

gubbins1.xls: 1, +2-100
gubbins2.xls: 1, +101-200
gubbins3.xls: 1, +201-300
gubbins4.xls: 1, +301-400
gubbins5.xls: 1, +401-500
gubbins6.xls: 1, +501-600

...as per the OP's request.<g>

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


 
Reply With Quote
 
Don Guillett
Guest
Posts: n/a
 
      25th Jan 2012
Why split em up when you can simply use
data>filter>autofilter>>>>>

On Jan 25, 10:50*am, John <helpme.c...@yahoo.com> wrote:
> Suppose a spreadsheet contains 600 rows of data.
>
> I'd love to be split this into separate workbooks containing 100 rows
> each.
> - I'd like the name format to be gubbins1.xls, gubbins2.xls,
> gubbins3.xls, gubbins4.xls, gubbins5.xls, gubbins6.xls
>
> - I'd like each workbook to keep row 1 of the original file (because
> it's a header row)
>
> ------
>
> Notes
> - I really want the output to be Excel spreadsheets (XLS etc), rather
> than CSV
> - Thanks for taking the time to read this!


 
Reply With Quote
 
GS
Guest
Posts: n/a
 
      26th Jan 2012
Well.., that's not going to work either! Here's my version of
Isabelle's approach...

Option Explicit

Sub ParseSheetToWorkbooks()
Dim wkbSource As Workbook, wkbTarget As Workbook
Dim x%, i%, lWksCount&, lCalcMode&
Dim bEventsEnabled As Boolean

Const sPath As String = "C:\temp" '//edit to suit
Set wkbSource = ActiveWorkbook

With Application
lWksCount = .SheetsInNewWorkbook: .SheetsInNewWorkbook = 1
lCalcMode = .Calculation: .Calculation = xlCalculationManual
bEventsEnabled = .EnableEvents: .EnableEvents = False
.ScreenUpdating = False
End With 'Application

For i = 1 To 501 Step 100
x = x + 1
Set wkbTarget = Workbooks.Add
If i = 1 Then
wkbSource.ActiveSheet.Rows(i & ":" & i + 99).Copy _
wkbTarget.ActiveSheet.Rows(1)
Else
With wkbSource
.ActiveSheet.Rows(1).Copy wkbTarget.ActiveSheet.Rows(1)
.ActiveSheet.Rows(i & ":" & i + 99).Copy _
wkbTarget.ActiveSheet.Rows(2)
End With 'wkbSource
End If
With wkbTarget
.SaveAs sPath & "\gubbins" & x & ".xls": .Close
End With 'wkbTarget
Next

With Application
.CutCopyMode = False
.SheetsInNewWorkbook = lWksCount: .Calculation = lCalcMode
.EnableEvents = bEventsEnabled: .ScreenUpdating = True
End With 'Application

Set wkbSource = Nothing: Set wkbTarget = Nothing
End Sub 'ParseSheetToWorkbooks

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc


 
Reply With Quote
 
isabelle
Guest
Posts: n/a
 
      26th Jan 2012
sorry i forgot to declare
cSheets As Integer

--
isabelle




Le 2012-01-25 12:49, isabelle a écrit :
> hi John,
>
> Sub Macro1()
> Dim wks1 As Workbook, wks2 As Workbook
> Dim x As Integer, i As Integer, cSheets As Integer '-----> new
> Dim pth As String
> pth = "C:\temp" 'adapt path
> cSheets = Application.SheetsInNewWorkbook
> Application.SheetsInNewWorkbook = 1
> Set wks1 = ActiveWorkbook
> Application.ScreenUpdating = False
>
> For i = 2 To 601 Step 100
> x = x + 1
> Set wks2 = Workbooks.Add
> wks1.ActiveSheet.Rows(1).Copy wks2.ActiveSheet.Rows(1)
> wks1.ActiveSheet.Rows(i & ":" & i + 99).Copy wks2.ActiveSheet.Rows(2)
> Application.CutCopyMode = False
> ActiveWorkbook.SaveAs Filename:=pth & "\gubbins" & x & ".xls", FileFormat:=xlNormal, _
> Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
> ActiveWindow.Close
> Next
>
> Application.SheetsInNewWorkbook = cSheets
> Set wks1 = Nothing
> Set wks2 = Nothing
> Application.ScreenUpdating = True
> End Sub
>
>
>

 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off



Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 06:05 AM.