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.
mabehrAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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)
            Else
                wsCsv.Name = CsvFileName
            End If
            
            ws.Select
            ws.Range(Cells(1, 1), Cells(1, colMax)).Copy
            wsCsv.Select
            wsCsv.Range("A1").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            ws.Select
            ws.Range(Cells(rwStart, 1), Cells(rwEnd, colMax)).Copy
            wsCsv.Select
            wsCsv.Range("A2").Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
            
            wsCsv.Move
            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

Make-csv-files.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
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!!!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.