split worksheet after empty row into separate workbooks

[Marylu]

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

 

[Per Jessen]

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

 

[Charles Simpson]

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

H

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

Sub SplitData2(
Dim MasterSh As Workshee
Dim FirstCell As Rang
Dim LastCell As Rang
Dim NewWb As Workboo
Dim vbName as Strin
Application.ScreenUpdating = Fals

Set MasterSh = Worksheets("Master"
Set FirstCell = MasterSh.Range("A1"
D
Set LastCell = FirstCell.End(xlDown
wbName = FirstCell.Offset(0, 5).Valu
Set NewWb = Workbooks.Ad
Range(FirstCell, LastCell).EntireRow.Cop
NewWb.Worksheets(1).Range("A1"
NewWb.SaveAs Filename:=wbNam
NewWb.Clos
Set FirstCell = LastCell.Offset(2, 0
Loop Until FirstCell = "
Application.ScreenUpdating = Tru
End Su

Regards
Per

Previous Posts In This Thread:

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

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

I will appreciate very much your advice dear experts

Sub SplitData(
mycount =
myrow =
D
mycount = mycount +
oldrow = myrow +
Sheets("Master").Selec
D
myrow = myrow +
Loop Until Sheets("Master").Range("A" & myrow) = "
Sheets.Ad
ActiveSheet.Name = "Data" & mycoun
Sheets("Master").Selec
Rows(oldrow & ":" & myrow).Selec
Selection.Cop
Sheets("Data" & mycount).Selec
Range("A1").Selec
ActiveSheet.Past
Loop Until Sheets("Master").Range("A" & myrow + 1) = "
End Sub

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

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

Sub SplitData2(
Dim MasterSh As Workshee
Dim FirstCell As Rang
Dim LastCell As Rang
Dim NewWb As Workboo
Dim vbName as Strin
Application.ScreenUpdating = Fals

Set MasterSh = Worksheets("Master"
Set FirstCell = MasterSh.Range("A1"
D
Set LastCell = FirstCell.End(xlDown
wbName = FirstCell.Offset(0, 5).Valu
Set NewWb = Workbooks.Ad
Range(FirstCell, LastCell).EntireRow.Cop
NewWb.Worksheets(1).Range("A1"
NewWb.SaveAs Filename:=wbNam
NewWb.Clos
Set FirstCell = LastCell.Offset(2, 0
Loop Until FirstCell = "
Application.ScreenUpdating = Tru
End Su

Regards
Per

EggHeadCafe - Software Developer Portal of Choice
..NET GDI+ - Convert BitMap To Jpeg
http://www.eggheadcafe.com/tutorial...accd-8291f3c89dfe/net-gdi--convert-bitma.aspx

 

[Per Jessen]

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