Microsoft Excel - Excel ? Separate rows on a workbook into separate workbooks.

I need help separating 45k rows of data, in a single worksheet into 45 separate workbooks (not sheets) in CSV format.  (1000 per workbook)

Data is:

First Name   Last Name    Address   Phone   City   State   Email   Notes

Any help would be greatly appreciated!

FYI - I am not technical - I am using Excel 2007

I think you'd have to use a macro... (By the way, a csv file isn't actually an Excel workbook.)

Press Alt+F11 to open the VBA editor and then Ctrl+R to see the Project Explorer. The Project Explorer should show a VBAProject for your workbook. If there is a plus to the left of the VBAProject, cick on the plus (+) to expand the object. If there is no section called Modules, right-click on the VBAProject object and Insert|Module. If there is already a module in the list, double-click on it. You should now have opened an edit window. Copy this code into the window, under any other code that may be there:

Sub MakeCSVs()
  Dim n As Integer, m As Integer, lastRow As Integer, lastCol As Integer
  Dim newWB As Workbook
  Dim path As String, fname As String
  path = "C:\Documents and Settings\Charles\My Documents\"
  filename = "File"
  lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
  lastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
  Application.ScreenUpdating = False
  n = 0
  While n * 1000 < lastRow
    Set newWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Activate
    Range(Cells(n * 1000 + 1, 1), Cells((n + 1) * 1000, lastCol)).Copy newWB.Sheets(1).Cells(1, 1)
    n = n + 1
    newWB.SaveAs FileName:=path & fname & Format(n, "00") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    newWB.Close False
  Wend
  Application.ScreenUpdating = True
End Sub

You'll need to change the path and fname strings to reflect the path where you want the files saved and the name you want to give each file. The name will have a number appended to it, so, using the above "File" as fname, the first file will be named File01.csv, the second named File02.csv, etc.

Close the VBA editor. In your workbook, press Alt+F8 and double-click on MakeCSVs.

A couple of mistakes crept in there. Use this code:

Sub MakeCSVs()
  Dim n As Integer, lastRow As Integer, lastCol As Integer
  Dim newWB As Workbook
  Dim path As String, fname As String
  path = "C:\Documents and Settings\Charles\My Documents\"
  fname = "File"
  lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
  lastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
  Application.ScreenUpdating = False
  n = 0
  While n * 1000 < lastRow
    Set newWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Activate
    Range(Cells(n * 1000 + 1, 1), Cells((n + 1) * 1000, lastCol)).Copy newWB.Sheets(1).Cells(1, 1)
    n = n + 1
    newWB.SaveAs FileName:=path & fname & Format(n, "00") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    newWB.Close False
  Wend
  Application.ScreenUpdating = True
End Sub

I believe I followed your instructions, but I got an error that just said "overflow"

Any ideas??

Thanks

Sub MakeCSVs()
  Dim n As Integer, lastRow As Integer, lastCol As Integer
  Dim newWB As Workbook
  Dim path As String, fname As String
  path = "C:\Users\Charles Work\4 Staffing\Candidates from Deorker\Candidates to import\"
  fname = "File"
  lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
  lastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
  Application.ScreenUpdating = False
  n = 0
  While n * 1000 < lastRow
    Set newWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Activate
    Range(Cells(n * 1000 + 1, 1), Cells((n + 1) * 1000, lastCol)).Copy newWB.Sheets(1).Cells(1, 1)
    n = n + 1
    newWB.SaveAs Filename:=path & fname & Format(n, "00") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    newWB.Close False
  Wend
  Application.ScreenUpdating = True
End Sub

Stupid mistake on my part. A VB integer is signed and only two bytes, so it overflows with more than 32,767 rows. Please try this:

Sub MakeCSVs()
  Dim n As Integer, lastRow As Long, lastCol As Integer
  Dim newWB As Workbook
  Dim path As String, fname As String
  path = "C:\Users\Charles Work\4 Staffing\Candidates from Deorker\Candidates to import\"
  fname = "File"
  lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
  lastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
  Application.ScreenUpdating = False
  n = 0
  While n * 1000 < lastRow
    Set newWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Activate
    Range(Cells(n * 1000 + 1, 1), Cells((n + 1) * 1000, lastCol)).Copy newWB.Sheets(1).Cells(1, 1)
    n = n + 1
    newWB.SaveAs FileName:=path & fname & Format(n, "00") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    newWB.Close False
  Wend
  Application.ScreenUpdating = True
End Sub

Sub MakeCSVs()
  Dim n As Integer, lastRow As Long, lastCol As Integer
  Dim newWB As Workbook
  Dim path As String, fname As String
  path = "C:\Users\Charles Work\4 Staffing\Candidates from Deorker\Candidates to import\"
  fname = "File"
  lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
  lastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
  Application.ScreenUpdating = False
  n = 0
  While n * 1000 < lastRow
    Set newWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Activate
    Range(Cells(n * 1000 + 1, 1), Cells((n + 1) * 1000, lastCol)).Copy newWB.Sheets(1).Cells(1, 1)
    n = n + 1
    newWB.SaveAs Filename:=path & fname & Format(n, "00") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    newWB.Close False
  Wend
  Application.ScreenUpdating = True
End Sub

I ran into another overflow issue, so I separated into two files, with the first one containing 30k rows and the second the remaining rows.  When I ran the same code on the second file I got a naming issue with using "file" again. I just changed the name to "file3" and it worked great. 

I do have another request though. I have columns labels on the top of the entire file and I would like them to be on each individual sheet, your code created.  If this is too much trouble I can just copy and paste each page. 

Thanks for all your help!

If you don't mind the first file having 1000 rows and the subsequent files having 1001 rows, you could try this:

Sub MakeCSVs()
  Dim n As Long, lastRow As Integer, lastCol As Integer
  Dim newWB As Workbook
  Dim path As String, fname As String
  path = "C:\Users\Charles Work\4 Staffing\Candidates from Deorker\Candidates to import\"
  fname = "File"
  lastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
  lastCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
  Application.ScreenUpdating = False
  n = 0
  While n * 1000 < lastRow
    Set newWB = Workbooks.Add(xlWBATWorksheet)
    ThisWorkbook.Activate
    If n = 0 Then
      Range(Cells(n * 1000 + 1, 1), Cells((n + 1) * 1000, lastCol)).Copy newWB.Sheets(1).Cells(1, 1)
    Else
      Range(Cells(1, 1), Cells(1, lastCol)).Copy newWB.Sheets(1).Cells(1, 1)
      Range(Cells(n * 1000 + 1, 1), Cells((n + 1) * 1000, lastCol)).Copy newWB.Sheets(1).Cells(2, 1)
    End If
    n = n + 1
    newWB.SaveAs FileName:=path & fname & Format(n, "00") & ".csv", FileFormat:=xlCSV, CreateBackup:=False
    newWB.Close False
  Wend
  Application.ScreenUpdating = True
End Sub

That should give you the same result as manually inserting the header row.

The "naming" issue isn't a bug; that was intentional. It won't let you overwrite existing files with the same names. I fixed the other overflow problem, so you shouldn't need to split the workbook manually.