Splitting workbook into several files

[Tira]

Hello! I am in need of a VBA code that opens a file (G:\FSG\Howard\Monthly Bank Volume Reports\Bank Report Variance File\US Bank Reports - Bank\US Bank Monthly Summary.xls) and save each tab/sheet in the workbook as a separate file, and the file name will be equal to the name of each sheet. Can someone please help?! Thanks

[YasserKhalil]

Try this code

Sub Test()
    Dim xPath       As String
    Dim fileName    As String
    Dim wb          As Workbook
    Dim xws         As Worksheet
    Dim c           As Long


    xPath = "G:\FSG\Howard\Monthly Bank Volume Reports\Bank Report Variance File\US Bank Reports - Bank\"
    fileName = xPath & "\" & "US Bank Monthly Summary.xls"
    Set wb = Workbooks.Open(fileName)


    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
        For c = 1 To wb.Worksheets.Count
            Set xws = Sheets(c)
            xws.Copy
            Application.ActiveWorkbook.SaveAs fileName:=xPath & "\" & xws.Name & ".xlsx"
            Application.ActiveWorkbook.Close False
            If c Mod 10 = 0 Then
                wb.Save
                wb.Close False
                Set wb = Workbooks.Open(fileName)
                DoEvents
            End If
        Next c
    
        wb.Close False
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

[Tira]

Hi YassweKhlil, the code is getting hung up at "xws.Copy".

[mdmackillop]

Extra "\"?

'Here 
xPath = "G:\FSG\Howard\Monthly Bank Volume Reports\Bank Report Variance File\US Bank Reports - Bank\" 
    fileName = xPath & "\" & "US Bank Monthly Summary.xls" 

'and here

Application.ActiveWorkbook.SaveAs fileName:=xPath & "\" & xws.Name & ".xlsx"

[Tira]

Hi mdmackillop,

I don't think you changed anything. I am still getting the same error, the line that has only "xws.copy"

[YasserKhalil]

It is better t upload sample of your workbook .. Is the file protected? What is the error message that appears to you?

[mdmackillop]

I didn't change anything. Remove the \ at the end of xPath.

[Tira]

When I ran the macro, I received a run time error code 1004, Method "Copy of Object'_Worksheet' failed. The macro above gets stuck at xws.copy. My document is listed as the "G" drive file. It has about 15 tabs I would like to split up and save as their tab/ (sheet name). Do you know why I might be getting an error? I tried your tip of removing the \ and nothing changed.

Please help with the macro

[MINCUS1308]

This should get you what you need...

Put this in a Module within the project and run it:

Sub Test()
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     ActiveWorkbook.Save
          
          xPath = Application.ActiveWorkbook.Path
          fileName = Application.ActiveWorkbook.FullName
          
          For MySheet = 1 To Sheets.Count
               Sheets(MySheet).Copy
               Application.ActiveWorkbook.SaveAs fileName:=xPath & "/" & Sheets(MySheet).Name & ".xlsx"
               Application.ActiveWorkbook.Close True
          Next MySheet
     
     Application.DisplayAlerts = True
     Application.ScreenUpdating = True
End Sub

if it errors out (It didn't on my machine), try flopping all of my "/" to "\"

[Tira]

Sooo.. All of the lovely codes keep getting hung up. The first one from Yasser Khalil opens up the document like I wanted it to but it doesn't go any further because it gets hung up at "xws.copy". Is there any way to fix this so that the code continues the process?

[mdmackillop]

Try

Set xws = Sheets(c) 
xws.Unprotect
        xws.Visible = xlSheetVisible
       xws.Copy

[Tira]

Mincus1308, I used part of the code you provided and changed "Sheets(MySheet).Copy to "Sheets.Copy" and added part of YasserKhalil's "xPath" code and got it to work. Thanks!