• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 269
  • Last Modified:

Split one sheet to many workbooks

I have a workbook (List_Distribution_DuplicatesRemoved.xls) that has a number of shhets (tabs) and each sheet has around 10,000 rows of data (some more some less).

I need to split each sheet into individual workbooks for every 1,000 rows and then name those files based on the tab name of each of the tab.

So for example there is a sheet in the workbook named Brooks Boucher. On this sheet there is approx 10,000 rows. I need a function that will divide that sheet into 1,000 rows (10 separate workbooks) and then name the new files: Brooks Boucher 1.csv, Brooks Boucher 2.csv, Brooks Boucher 3.csv and so on up until all the rows are taken from the original 10,000 rowed sheet.

If converting it from a xls to cvs is not doable or problematic then just having them as .xls files will be fine and I will rename.

And, I need the above for each tab I have in the List_Distribution_DuplicatesRemoved.xls workbook.

Would save me a LOT of time if someone could help me with this.
1 Solution
Ejgil HedegaardCommented:
Try this, see sample file with 2 sheets.
Insert the code in a module in the workbook List_Distribution_DuplicatesRemoved.xls.
The csv files are created in the same folder as the workbook, and will be named
Brooks Boucher 001.CSV, Brooks Boucher 002.CSV etc., or whatever the tab name is.
The first row (Header) is repeated for each file.

Option Explicit
Dim ws As Worksheet, wsCsv As Worksheet
Dim rwMax As Long, rwStart As Long, rwEnd As Long, colMax As Integer
Dim FileNbr As Integer, FileNbrMax As Integer
Dim CsvFileName As String

Const MaxRowsInFiles As Long = 1000

Sub MakeCsvFiles()
    ChDrive Left(ThisWorkbook.Path, 2)
    ChDir ThisWorkbook.Path
    Application.ScreenUpdating = False
    For Each ws In ThisWorkbook.Worksheets
        rwMax = ws.Range("A1").CurrentRegion.Rows.Count
        colMax = ws.Range("A1").CurrentRegion.Columns.Count
        FileNbrMax = Int(rwMax / (MaxRowsInFiles - 1)) + 1
        rwStart = 2
        For FileNbr = 1 To FileNbrMax
            CsvFileName = ws.Name + " "
            If FileNbr < 100 Then CsvFileName = CsvFileName + "0"
            If FileNbr < 10 Then CsvFileName = CsvFileName + "0"
            CsvFileName = CsvFileName + Trim(Str(FileNbr))
            rwEnd = rwStart + MaxRowsInFiles - 2
            If rwEnd > rwMax Then
                rwEnd = rwMax
            End If
            Set wsCsv = Worksheets.Add
            If Len(CsvFileName) > 31 Then
                wsCsv.Name = Left(CsvFileName, 27) + Right(CsvFileName, 4)
                wsCsv.Name = CsvFileName
            End If
            ws.Range(Cells(1, 1), Cells(1, colMax)).Copy
            Application.CutCopyMode = False
            ws.Range(Cells(rwStart, 1), Cells(rwEnd, colMax)).Copy
            Application.CutCopyMode = False
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs Filename:=CsvFileName, FileFormat:=xlCSV
            Application.DisplayAlerts = True
            ActiveWorkbook.Close Savechanges:=False
            rwStart = rwEnd + 1
        Next FileNbr
    Next ws
End Sub

Open in new window

mabehrAuthor Commented:
Talk about stupendous! Wow! That worked marvelously. Thanks Ejgil. I had twenty sheets on the original workbook and it spit everyone of them into csv files of 1,000 rows each, creating over 200 csv files all named correctly,

Couldn't ask for anything more.

Thank you!!!

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now