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!

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!

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

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

Why split em up when you can simply use
datafilterautofilter

On Jan 25, 10:50*am, John 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!

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

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