View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen Per Jessen is offline
external usenet poster
 
Posts: 1,533
Default I need to separate 45K rows of data into 45 separate workbooks (1000 rows per)

Hi

Try this:

Sub SplitDataToCSV()
Dim MasterSh As Worksheet
Dim FirstRow As Long
Dim LastRow As Long
Dim NewWb As Workbook
Dim wbName As String
Dim counter As Long
Application.ScreenUpdating = False

Set MasterSh = Worksheets("Master")
FirstRow = 1
LastRow = MasterSh.Range("A" & Rows.Count).End(xlUp).Row
For r = FirstRow To LastRow Step 1000
counter = counter + 1
wbName = "Exported" & counter & ".csv" ' change name as required
Set NewWb = Workbooks.Add
MasterSh.Range("A" & r).Resize(1000, 1).EntireRow.Copy _
NewWb.Worksheets(1).Range("A1")

NewWb.SaveAs Filename:=wbName, _
FileFormat:=xlCSV, CreateBackup:=False
NewWb.Close
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per

"Charles Simpson" skrev i meddelelsen
...
I am hoping that you can help me. I need to separate 45k rows of data into
45 separate workbooks (not sheets)
The data is First name, last name, phone, email, address.

I need these to be saved as CSV files. I am not at all a programmer and
do not know much about VB.

Thank you!



Per Jessen wrote:

HiI assume you have the 'new' workbook name if first row of each data set
17-Oct-09

Hi

I assume you have the 'new' workbook name if first row of each data set in
column 6 and one empty row between each data set.

Sub SplitData2()
Dim MasterSh As Worksheet
Dim FirstCell As Range
Dim LastCell As Range
Dim NewWb As Workbook
Dim vbName as String
Application.ScreenUpdating = False

Set MasterSh = Worksheets("Master")
Set FirstCell = MasterSh.Range("A1")
Do
Set LastCell = FirstCell.End(xlDown)
wbName = FirstCell.Offset(0, 5).Value
Set NewWb = Workbooks.Add
Range(FirstCell, LastCell).EntireRow.Copy
NewWb.Worksheets(1).Range("A1")
NewWb.SaveAs Filename:=wbName
NewWb.Close
Set FirstCell = LastCell.Offset(2, 0)
Loop Until FirstCell = ""
Application.ScreenUpdating = True
End Sub

Regards,
Per

Previous Posts In This Thread:

On Friday, October 16, 2009 9:16 PM
Marylu wrote:

split worksheet after empty row into separate workbooks
I use syntax to split my Master worksheet into several worksheets in the
same
workbook but now I need to be able to create separate workbooks with only
one
worksheet information instead of separate worksheets.

How can I modify this syntax and also to be able to name my workbooks
acording to the name I have in column 6.

I will appreciate very much your advice dear experts.

Sub SplitData()
mycount = 0
myrow = 0
Do
mycount = mycount + 1
oldrow = myrow + 1
Sheets("Master").Select
Do
myrow = myrow + 1
Loop Until Sheets("Master").Range("A" & myrow) = ""
Sheets.Add
ActiveSheet.Name = "Data" & mycount
Sheets("Master").Select
Rows(oldrow & ":" & myrow).Select
Selection.Copy
Sheets("Data" & mycount).Select
Range("A1").Select
ActiveSheet.Paste
Loop Until Sheets("Master").Range("A" & myrow + 1) = ""
End Sub

On Saturday, October 17, 2009 3:15 AM
Per Jessen wrote:

HiI assume you have the 'new' workbook name if first row of each data set
Hi

I assume you have the 'new' workbook name if first row of each data set in
column 6 and one empty row between each data set.

Sub SplitData2()
Dim MasterSh As Worksheet
Dim FirstCell As Range
Dim LastCell As Range
Dim NewWb As Workbook
Dim vbName as String
Application.ScreenUpdating = False

Set MasterSh = Worksheets("Master")
Set FirstCell = MasterSh.Range("A1")
Do
Set LastCell = FirstCell.End(xlDown)
wbName = FirstCell.Offset(0, 5).Value
Set NewWb = Workbooks.Add
Range(FirstCell, LastCell).EntireRow.Copy
NewWb.Worksheets(1).Range("A1")
NewWb.SaveAs Filename:=wbName
NewWb.Close
Set FirstCell = LastCell.Offset(2, 0)
Loop Until FirstCell = ""
Application.ScreenUpdating = True
End Sub

Regards,
Per

EggHeadCafe - Software Developer Portal of Choice
.NET GDI+ - Convert BitMap To Jpeg
http://www.eggheadcafe.com/tutorials...ert-bitma.aspx