Easy Macro? Split Existing Document into seperate files, no more than 50 rows each, keep 1st column info

[jeffcoleky]

Theoretically this should be easy right?

I have a file with 300 names. It looks something like this (Except MUCH longer):

Excel 2010
	A	B
1	Name	E-Mail
2	Bob	Bob@bogusemail.com
3	Ryan	Ryan@bogusemail.com
4	scott	scott@bogusemail.com
5	Mark	Mark@bogusemail.com
6	Santo	Santo@bogusemail.com
7	Marsha	Marsha@bogusemail.com
8	Sharon	Sharon@bogusemail.com
9	Daniel	Daniel@bogusemail.com
10	Jerry	Jerry@bogusemail.com
Sheet1

I need to create a macro that takes the open document and splits the list into multiple files:

• Keeping the maximum lines to 50 on each file (51 including A1:B1).
• The new name of the files should be the same as the open document, with a "1" or "2" at the end to show it's split.
• Files should be saved to the same folder as the one that's being used (or pre-set to a path, whichever is easier).
• Cells A1 & B1 Should remain the same throughout each file. They never change: Cell A1 is always "Name" and Cell B1 is always "E-Mail"

An example would be:

List.csv (275 Rows total)

--TURNS INTO--

List1.csv -- 51 Rows of data (including the header)
List2.csv -- 51 Rows of data (including the header)
List3.csv -- 51 Rows of data (including the header)
List4.csv -- 51 Rows of data (including the header)
List5.csv -- 51 Rows of data (including the header)
List6.csv -- The last 26 Rows of data from List.csv (including the header)

To an excel guru i'm sure this would be very easy so hopefully my explanation is clear enough that you agree. ANY help is much appreciated!

 

[Momentman]

Hi jeff

Am definitely not an excel guru but see if this works for you

Sub split2sheets()

Set wks = ActiveWorkbook
lastrow = Range("A1").End(xlDown).Row

j = 1
For I = 2 To lastrow Step 50
wks.Activate
ActiveSheet.Range(Cells(I, "A"), Cells(I + steps - 1, "B")).Copy
Workbooks.Add
Range("A2").Select
ActiveSheet.Paste
Range(Cells(1, 1), Cells(1, 2)) = Array("NAMES", "E-MAIL")
ActiveWorkbook.SaveAs Filename:="List" & j & ".csv"
ActiveWorkbook.Close
j = j + 1

Next I
End Sub

 

[JLGWhiz]

It might look easy, but it is really complex.

Code:
Sub newWkBk()
Dim sh As Worksheet, lr As Long, newWb As Workbook, fName As String, nbr As Long
Set sh = Sheets(1)
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
fName = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
nbr = 1
For i = 2 To lr Step 50
Set newWb = Workbooks.Add
newWb.SaveAs fName & nbr & ".xlsx"
sh.Range("A1:B1").Copy newWb.Sheets(1).Range("A1")
sh.Range("A" & i).Resize(50, 2).Copy newWb.Sheets(1).Range("A2")
nbr = nbr + 1
Next
End Sub
Code:

 

[jeffcoleky]

Hi jeff

Am definitely not an excel guru but see if this works for you

Sub split2sheets()

Set wks = ActiveWorkbook
lastrow = Range("A1").End(xlDown).Row

j = 1
For I = 2 To lastrow Step 50
wks.Activate
ActiveSheet.Range(Cells(I, "A"), Cells(I + steps - 1, "B")).Copy
Workbooks.Add
Range("A2").Select
ActiveSheet.Paste
Range(Cells(1, 1), Cells(1, 2)) = Array("NAMES", "E-MAIL")
ActiveWorkbook.SaveAs Filename:="List" & j & ".csv"
ActiveWorkbook.Close
j = j + 1

Next I
End Sub

It was a valiant effort but the result was separate files with only two lines in each.

 

[jeffcoleky]

It might look easy, but it is really complex.

Code:
Sub newWkBk()
Dim sh As Worksheet, lr As Long, newWb As Workbook, fName As String, nbr As Long
Set sh = Sheets(1)
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
fName = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1)
nbr = 1
For i = 2 To lr Step 50
Set newWb = Workbooks.Add
newWb.SaveAs fName & nbr & ".xlsx"
sh.Range("A1:B1").Copy newWb.Sheets(1).Range("A1")
sh.Range("A" & i).Resize(50, 2).Copy newWb.Sheets(1).Range("A2")
nbr = nbr + 1
Next
End Sub
Code:

Wow, it is complex but it works PERFECTLY. Thanks so much for taking the time to make it for me. This will be a big help. Thanks to Momentman for trying too!

 

[jeffcoleky]

Wow, it is complex but it works PERFECTLY. Thanks so much for taking the time to make it for me. This will be a big help. Thanks to Momentman for trying too!

OOPS, perfectly except for one thing. The file format needs to remain as a ".CSV". I tried changing the extension in the code to .csv but that didn't work. The app i use to open the file doesn't recognize it as a CSV. Is there a simple modification that can be made to make it export the CSV format instead of the XLSX format?

 

[JLGWhiz]

OOPS, perfectly except for one thing. The file format needs to remain as a ".CSV". I tried changing the extension in the code to .csv but that didn't work. The app i use to open the file doesn't recognize it as a CSV. Is there a simple modification that can be made to make it export the CSV format instead of the XLSX format?

You wouldn't want to change the file extension on the SaveAs where it is located in the code now. The data has not been copied to the file at that point. You would need to add another SaveAs command after the data is copied to the file. If the application you are using will not allow that, the the alternative is to open the new files in Excel and save them from there to a .csv file.

 

[jeffcoleky]

I'm running this script in excel, not another application. What i meant was that the application can't open the end result of what this script produces if it's in XLSX format. It can read CSV files.

You can surely understand that I would like to avoid having to do a save as CSV for each file whenever I run the macro in excel.

Is there an easy fix to the script that could change the output format?

 

[JLGWhiz]

I'm running this script in excel, not another application. What i meant was that the application can't open the end result of what this script produces if it's in XLSX format. It can read CSV files.

You can surely understand that I would like to avoid having to do a save as CSV for each file whenever I run the macro in excel.

Is there an easy fix to the script that could change the output format?

You have me confused. Excel will saveas as csv file. The output of the macro provided would produce files compatible with xl2007 + and should be easily convertible to .csv through a saveas command, inserted into the macro at the point after the "copy" command and before the "next" command. If your version of excel is prior to xl2007 then it would not be compatible with the .xlsx file extension and could present problems (not sure) in trying to do the saveas. But if your version is pre 2007, the macro should have hiccuped when it tried to saveas to .xlsx. So, as I said, I am confused. Or are you telling me that you don't know how to insert the saveas command?

 

[jeffcoleky]

Or are you telling me that you don't know how to insert the saveas command?

Yup. You Got it.

PS. I have excel 2010 Professional Plus