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? :hi:

[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!