How could I split a spreadsheet containing 600 rows, so there's100 rows in each new workbook
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!
|