Split workbook to separate excel files

/, VBA/Split workbook to separate excel files

In relation to my previous post I received few queries on how to separate each worksheet in a workbook to separate excel files.

If you want to use the VBA code below without altering it, you will need to follow the below steps:
1. Press the keys ALT + F11 to open the Microsoft Visual Basic for Applications.
2. From the menu options go to Tools and select the References menu item.

Excel Tools References Menu Item

3. From the available references check the

  • Microsoft Visual Basic for Applications Extensibility 5.3
  • Microsoft Scripting Runtime

split_workbook_to_files_references

4. From the File menu option select Options.
5. Select Trust Center and then click on the Trust Center Settings button.

excel_file_trust_center_settings

6. Select the Macro Settings and check the option Trust access VBA project object model.
Enabling this option will allow the macro to read the VB components from VBA project.
excel_file_macro_settings_trust_access_to_vba

To run the code
1. While you are on the excel sheet press the keys ALT + F8 to open the macro window
2. Select the macro SplitWorkbook and click on run.

Split Workbook Run Macro

3. Select the folder where you want the workbook will be split into multiple excel files per worksheet.

Select Folder to Split Workbook Into Excel Files

4. If the workbook you are saving into multiple excel files is macro enabled, you will prompted with the option to copy the VBA project. If you click on Yes button then the workbook split will create multiple excel files copying all the class, modules and form objects from the VBA Project into the new excel files. If you select the option No the simple excel workbook file will be created and it won’t include any macro which was present in the original excel file.

Excel File Copy VBAPrject

Option Explicit

'Note: If you are using Office 2010 _
      Look at https://support.microsoft.com/en-gb/kb/983043
#If VBA7 Then
    Private Declare PtrSafe Function GetTempFileName Lib "kernel32" _
    Alias "GetTempFileNameA" _
    (ByVal lpszPath As String, _
    ByVal lpPrefixString As String, _
    ByVal wUnique As Long, _
    ByVal lpTempFileName As String) As Long
#Else
    Private Declare Function GetTempFileName Lib "kernel32" _
    Alias "GetTempFileNameA" _
    (ByVal lpszPath As String, _
    ByVal lpPrefixString As String, _
    ByVal wUnique As Long, _
    ByVal lpTempFileName As String) As Long
#End If

Sub SplitWorkbook()
    Dim sPath As String
    Dim oSheet As Worksheet
    Dim oSrcWorkbook As Workbook
    Dim oDstWorkBook As Workbook
    Dim bCopyVBAProject As Boolean
    Dim oComponent As VBComponent
    Dim sComponentName As String
    Dim sTempPath As String
    Dim oFSO As FileSystemObject
    Dim bufferLeft
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    
    Set oSrcWorkbook = ActiveWorkbook
    
   
    sPath = SelectFolder()
    
    If oSrcWorkbook.FileFormat = xlOpenXMLWorkbookMacroEnabled Then
        bCopyVBAProject = MsgBox("Do you want to copy the VBA code to the new workbooks?", vbYesNo, "Copy VBAProject") = vbYes
        
        If bCopyVBAProject Then
            sTempPath = GetTempFolder()
            
            CreateFolder oFSO, sTempPath 'Create temporary folder
            'Trust access VBA project object model must be checked _
            in Macro Settings.
            For Each oComponent In oSrcWorkbook.VBProject.VBComponents
                If Not oComponent.Type = vbext_ct_Document Then
                    oComponent.Export sTempPath & oComponent.Name
                End If
            Next
        End If
    End If
    
    For Each oSheet In ActiveWorkbook.Sheets
        oSheet.Copy 'Copy the sheet to new workbook
        Set oDstWorkBook = ActiveWorkbook
        If bCopyVBAProject Then
            ImportComponents oFSO, oDstWorkBook, sTempPath
            oDstWorkBook.SaveAs Filename:=sPath & "\" & oSheet.Name, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Else
            oDstWorkBook.SaveAs Filename:=sPath & "\" & oSheet.Name
        End If
        oDstWorkBook.Close False
    Next
    
    If bCopyVBAProject Then DeleteFolder oFSO, sTempPath 'Remove temporary folder and files
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Set oComponent = Nothing
    Set oDstWorkBook = Nothing
    Set oSheet = Nothing
    Set oSrcWorkbook = Nothing
    Set oFSO = Nothing
End Sub

Private Sub ImportComponents(ByRef oFSO As FileSystemObject, ByRef oDstWorkBook As Workbook, ByVal sComponentsPath As String)
    Dim oFile As File
    If oFSO Is Nothing Then Set oFSO = New FileSystemObject
    
    For Each oFile In oFSO.GetFolder(sComponentsPath).Files
        oDstWorkBook.VBProject.VBComponents.Import oFile.Path
    Next
End Sub


Private Sub CreateFolder(ByRef oFSO As FileSystemObject, ByVal sPath As String)
    If Len(Trim(sPath)) > 0 Then
        If oFSO Is Nothing Then Set oFSO = New FileSystemObject
        oFSO.CreateFolder sPath
    End If
End Sub

Private Sub DeleteFolder(ByRef oFSO As FileSystemObject, ByVal sPath As String)
    If Len(Trim(sPath)) > 0 Then
        If oFSO Is Nothing Then Set oFSO = New FileSystemObject
        If oFSO.FolderExists(sPath) Then oFSO.DeleteFolder sPath, True
    End If
End Sub

Private Function SelectFolder() As String
    Dim oFolderDialog As FileDialog
    Dim sFolder As String
    Set oFolderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    With oFolderDialog
        .Title = "Select a folder"
        .AllowMultiSelect = False
        .InitialFileName = ""
        If .Show <> -1 Then GoTo ExitCode
        sFolder = .SelectedItems(1)
    End With

ExitCode:
    SelectFolder = sFolder
    Set oFolderDialog = Nothing
End Function

Private Function GetTempFolder() As String
  Dim sTmpPath As String * 512
  Dim sTmpName As String * 576
  Dim nRet As Long
  Dim F As String

  nRet = GetTempFileName("", "", 0, sTmpName)
  If nRet <> 0 Then F = Left$(sTmpName, InStr(sTmpName, vbNullChar) - 1)
  
  GetTempFolder = Environ("temp") & F
End Function

After the macro execution is finished you will find the excel file in the folder you selected above.

If you have any questions about the code or have any suggestions on improvement please let me know.

2017-03-07T20:32:28+00:00 October 24th, 2016|Excel, VBA|0 Comments

Leave A Comment