VBA Code assistance to separate a workbook into several different files.

[Tira]

I am using the code below to open up a workbook titled "US Bank Monthly Summary". It has several sheets within this workbook. I want to separate each sheet into its own file and the sheet name is used for the "save as" name. I need someone to help me with a new code and/or tweek the one below. It creates several files but it puts all sheets into each file. (I NEED ONE SHEET PER FILE). Taking a stab at this again. Thanks!

Sub Test()


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)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Save

xPath = Application.ActiveWorkbook.Path
fileName = Application.ActiveWorkbook.FullName

For MySheet = 1 To Sheets.Count
Sheets.Copy
Application.ActiveWorkbook.SaveAs fileName:=xPath & "/" & Sheets(MySheet).Name & ".xlsx"
Application.ActiveWorkbook.Close True
Next MySheet

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[mancubus]

please use code tags when posting your code.



Sub vbax_60398_save_each_sheet_as_separate_workbook()


Dim wb As Workbook, ws As Worksheet

Application.ScreenUpdating = False

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

For Each ws In wb.Worksheets
If ws.Visible = True Then 'handles hidden sheets
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=ThisWorkbook.Path & "\" & ws.Name, FileFormat:=56 '56 for xls, 51 for xlsx, 52 for xlsm
.Close False
End With
End If
Next ws

wb.Close False

Application.ScreenUpdating = True

End Sub

[Tira]

Hi, I am not sure what code tags are. Also when I pasted this code into Excel developer and ran it. It didn't work all the way through. Also, I need the files to be saved at "G:\FSG\Howard\Monthly Bank Volume Reports\Bank Report Variance File\US Bank Reports - Bank\" , so how do you incorporate this into your code?

Thanks!

[SamT]

so how do you incorporate this into your code?
ThisWorkbook.Path & "\"

The # Icon will insert Code Formatting Tags into your message.

You can select the code and Click the Icon. This will place the tags around the selected text.

You can click the Icon and paste your code between the tags.

You can manually type the tags before and after your code.

[mancubus]

what code tags are
see my signature titled "posting code"


the files to be saved at "G:\FSG\Howard\Monthly Bank Volume Reports\Bank Report Variance File\US Bank Reports - Bank\


Sub vbax_60398_save_each_sheet_as_separate_workbook()

Dim wb As Workbook, ws As Worksheet
Dim xPath As String

Application.ScreenUpdating = False

xPath = ""G:\FSG\Howard\Monthly Bank Volume Reports\Bank Report Variance File\US Bank Reports - Bank\"

Set wb = Workbooks.Open(xPath & US Bank Monthly Summary.xls")

For Each ws In wb.Worksheets
If ws.Visible = True Then 'handles hidden sheets
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=(xPath & ws.Name, FileFormat:=56 '56 for xls, 51 for xlsx, 52 for xlsm
.Close False
End With
End If
Next ws

wb.Close False

Application.ScreenUpdating = True

End Sub

[Tira]

I can't seem to get any of these codes to work. The last one posted by mancubus got hung up at ".SaveAs Filename....."

Can some one tweek the code below so that only one tab is saved in each file.

Thanks!


Sub Test()


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)

Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Save

xPath = Application.ActiveWorkbook.Path
fileName = Application.ActiveWorkbook.FullName

For MySheet = 1 To Sheets.Count
Sheets.Copy
Application.ActiveWorkbook.SaveAs fileName:=xPath & "/" & Sheets(MySheet).Name & ".xlsx"
Application.ActiveWorkbook.Close True
Next MySheet

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[mancubus]

Sub Test()

Dim wb As Workbook
Dim xPath As String
Dim MySheet As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

xPath = "G:\FSG\Howard\Monthly Bank Volume Reports\Bank Report Variance File\US Bank Reports - Bank\"

Set wb = Workbooks.Open(xPath & "US Bank Monthly Summary.xls")

For MySheet = 1 To wb.Sheets.Count
wb.Sheets(MySheet).Copy
ActiveWorkbook.SaveAs Filename:=xPath & wb.Sheets(MySheet).Name & ".xlsx", FileFormat:=51 '56 for xls, 51 for xlsx, 52 for xlsm
ActiveWorkbook.Close False 'file already saved as
Next MySheet

wb.Close False

End Sub

[Tira]

something is wrong at the line below. When I ran the code it got hung up right there.

ActiveWorkbook.SaveAs Filename:=xPath & Sheets(MySheet).Name & ".xlsx", FileFormat:=51 '56 for xls, 51 for xlsx, 52 for xlsm

[Tira]

Please help me to get this!! Why would the code get hung up at the above line.

Thanks!!

[mdmackillop]

wb. qualifier added

ActiveWorkbook.SaveAs Filename:=xPath & wb.Sheets(MySheet).Name & ".xlsx", FileFormat:=51 '56 for xls, 51 for xlsx, 52 for xlsm

[Tira]

Good to Go! Thanks!