VBA – Split worksheet to worksheets, save Excel worksheets to csv

Same article, but for Python is here – https://www.vitoshacademy.com/python-split-worksheet-to-worksheets-save-excel-worksheets-to-csv/

This article does 2 things:

  • Splits one worksheet to multiple worksheets
  • Then goes through the worksheets and saves them as *.CSV files

I hope that is enough for you.

#RandomMountain

Ok, so we start with the following Excel file like this:

Make sure to declare the worksheet with the inital data here correspondingly – `Public Const WKS_TO_KEEP As String = “Tabelle1″`. In my case, it is `”Tabelle1″`.

 

And the idea is to split this main worksheet into multiple other worksheets, keeping the title [Alpha, Bravo, Charlie, Delta] and starting each fifth row on a new worksheet. Like this:

The first worksheet with name `1` contains the values from the first 5 rows. This is the second, it is named `6` and it contains the next 5 values, from row 6 to row 10.

The fifth row is optional, of course. The interesting part is that we got all the data split into new worksheets. Then, the last step is to create a separate CSV file from each of those worksheets:

“CSV_FILE” comes from `Public Const CSV_NAME As String = “CSV_FILE”`

This is pretty much all. The code to get this done is below:

Option Explicit

Public Const CSV_NAME As String = "CSV_FILE"
Public Const MY_STEP As Long = 5
Public Const WKS_TO_KEEP As String = "Tabelle1"
'

Function WksToKeep() As Worksheet

    Set WksToKeep = ThisWorkbook.Worksheets(WKS_TO_KEEP)

End Function

Sub SplitMe()
       
    OnStart
   
    Dim myLastRow As Long: myLastRow = LastRow(WksToKeep)
    Dim myCell As Range, i As Long
    
    For i = 1 To myLastRow Step MY_STEP
    
        With WksToKeep
        
            Dim newWks As Worksheet
            Set newWks = ThisWorkbook.Worksheets.Add(ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWks.Name = i
            newWks.Rows(1).Value = .Rows(1).Value
            
            Dim ii As Long
            For ii = 2 To MY_STEP + 1
               
                With newWks
                    newWks.Rows(ii).Value = WksToKeep.Rows(i + ii - 1).Value
                End With

            Next
        End With
    Next
    
    OnEnd
   
End Sub

Public Sub DeleteAllButOne()
       
    Dim wks As Worksheet
    OnStart
    For Each wks In ThisWorkbook.Worksheets
        If wks.Name <> WKS_TO_KEEP Then
            wks.Delete
        End If
    Next wks
    OnEnd

End Sub

Public Sub MakeMeACSV()
   
    Dim myNewWorkbook As Workbook
    OnStart
   
    Dim myWorksheet As Worksheet
    For Each myWorksheet In ThisWorkbook.Worksheets
        If myWorksheet.Name <> WKS_TO_KEEP Then
            
            Set myNewWorkbook = Workbooks.Add
            myWorksheet.Copy myNewWorkbook.Sheets(1)
            
            myNewWorkbook.Worksheets(WKS_TO_KEEP).Delete
           
            Dim myFileName As String
            myFileName = ThisWorkbook.Path & "\"
            myFileName = myFileName & CSV_NAME & Format(Date, "YYYYMMDD") & "_" & Format(Now(), "hhnnss") & ".csv"
           
            myNewWorkbook.Worksheets(1).Columns(1).Delete
           
            If myNewWorkbook.Worksheets(1).Cells(2, 1).Value = "" Then
                myNewWorkbook.Worksheets(1).Rows(1).Delete
            End If
           
            Debug.Print myNewWorkbook.Path
            myNewWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlCSV, local:=True
            myNewWorkbook.Close False
           
        End If
    Next
   
    OnEnd
End Sub

Sub Main()

    SplitMe
    MakeMeACSV
   
End Sub

Public Sub OnStart()
   
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlAutomatic
    Application.EnableEvents = False

End Sub

Public Sub OnEnd()
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.StatusBar = False
   
End Sub

Public Function LastColumn(ws As Worksheet, Optional rowToCheck As Long = 1) As Long

    LastColumn = ws.Cells(rowToCheck, ws.Columns.Count).End(xlToLeft).Column
    
End Function

Public Function LastRow(ws As Worksheet, Optional columnToCheck As Long = 1) As Long
    
    LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row

End Function

What is worth mentioning is the following:

  • To run the first step, run SplitMe() , for the second step run MakeMeACSV().
    • The CSV files are made in the folder of the Excel file, in which the code resides.
  • The constants on the top of the code are actually rather important:
    • Make sure that you have a worksheet named “Tabelle1” or it will not work.
    • Furthermore “Tabelle1” is the worksheet, that should contain the initial data, to be splitted.
  • If you make a mistake, use DeleteAllButOne(), which will delete all worksheets, but the one declared with this one – WKS_TO_KEEP.
  • In my code, I am deleting the first column in the CSV file (Alpha), because I do not need it.
    • Just comment out this line –  myNewWorkbook.Worksheets(1).Columns(1).Delete , if you want to keep it.

That’s all! I have even added this one to my boilerplate!