saving a big spreadsheet in chunks

J

jack.buckley

Hi,
I need to take a large (many rows, few columns) worksheet and split it
up into a bunch of csv files that can be no longer than 35 rows (the
server application we are uploading them to can only take 35 rows at a
time). Can anyone point me in the right direction? I have programming
experience but don't work much with Excel.

Thanks for your time and consideration,

Jack
 
N

Nick Hodge

Jack

This code discovers the last row in A and the last column being used in row
1. It then presumes the range is contiguous. It runs against that code every
36 rows, pasting them to a new file which it then saves as a csv file to a
folder called csv in the root drive (C:\), incrementing the file name by one
each iteration.

I tested it with 3000 rows and it made 86 csv's. Give it a try

Sub DivideCSVs()
Dim lLastRow As Long
Dim iLastColumn As Integer
Dim x As Integer, y As Integer
Dim currWks As Worksheet
Dim newWB As Workbook
Dim newWks As Worksheet
Set currWks = ActiveSheet
lLastRow = currWks.Range("A65536").End(xlUp).Row
iLastColumn = currWks.Range("IV1").End(xlToLeft).Column
y = 1
For x = 1 To lLastRow Step 35
currWks.Range(Cells(x, 1), Cells(x + 35, iLastColumn)).Copy
Set newWB = Workbooks.Add
Set newWks = Worksheets.Add
newWks.Paste
Application.DisplayAlerts = False
newWB.SaveAs Filename:="C:\CSVs\CSVFileNo" & y & ".csv", FileFormat:=xlCSV
newWB.Close SaveChanges:=False
Application.DisplayAlerts = True
Set newWks = Nothing
Set newWB = Nothing
y = y + 1
Next x
End Sub


--
HTH
Nick Hodge
Microsoft MVP - Excel
Southampton, England
[email protected]
www.nickhodge.co.uk
 
D

Dave Peterson

One way:

Option Explicit
Sub CreateFiles()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim iRow As Long
Dim myStep As Long
Dim myFolderName As String
Dim wCtr As Long

myFolderName = "C:\temp\"

Set CurWks = Worksheets("sheet1")
Set NewWks = Workbooks.Add(1).Worksheets(1)

myStep = 35
wCtr = 0
With CurWks
For iRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step myStep
NewWks.Cells.Clear 'just in case
.Rows(iRow).Resize(myStep).Copy _
Destination:=NewWks.Range("a1")
wCtr = wCtr + 1
Application.DisplayAlerts = False
NewWks.Parent.SaveAs _
FileName:=myFolderName & Format(wCtr, "0000") & ".csv", _
FileFormat:=xlCSV
Application.DisplayAlerts = True
Next iRow
End With

NewWks.Parent.Close savechanges:=False

MsgBox "Done."

End Sub

make sure that your folder that gets the files already exists. I used c:\temp.
 
J

jack.buckley

Thanks a ton for your rapid assistance!

J

Dave said:
One way:

Option Explicit
Sub CreateFiles()

Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim iRow As Long
Dim myStep As Long
Dim myFolderName As String
Dim wCtr As Long

myFolderName = "C:\temp\"

Set CurWks = Worksheets("sheet1")
Set NewWks = Workbooks.Add(1).Worksheets(1)

myStep = 35
wCtr = 0
With CurWks
For iRow = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row Step myStep
NewWks.Cells.Clear 'just in case
.Rows(iRow).Resize(myStep).Copy _
Destination:=NewWks.Range("a1")
wCtr = wCtr + 1
Application.DisplayAlerts = False
NewWks.Parent.SaveAs _
FileName:=myFolderName & Format(wCtr, "0000") & ".csv", _
FileFormat:=xlCSV
Application.DisplayAlerts = True
Next iRow
End With

NewWks.Parent.Close savechanges:=False

MsgBox "Done."

End Sub

make sure that your folder that gets the files already exists. I used c:\temp.
Click to expand...
 
Top