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

[John]

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!

 

[isabelle]

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 :

 

[GS]

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

 

[GS]

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>

 

[Don Guillett]

Why split em up when you can simply use
data>filter>autofilter>>>>>

 

[GS]

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

 

[isabelle]

sorry i forgot to declare
cSheets As Integer

--
isabelle




Le 2012-01-25 12:49, isabelle a écrit :