Help with a VBA code to separate a workbook into many different files

[Tira]

I have a previous code that I got off of here to separate the files that are in one workbook into several different ones and "save as" the name on the tab. Everything works find except it saves all the worksheets instead of one into each file. Can someone fix the code below so that only one tab is saved per 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

[Logit]

.
Try this:

Option Explicit


Sub SplitWorkbook()
'Updateby20140612
Dim FileExtStr, DateString, xFile As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hhmm")
FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
    xWs.Copy
    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        Select Case xWb.FileFormat
            Case 51:
                FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If Application.ActiveWorkbook.HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56:
                FileExtStr = ".xls": FileFormatNum = 56
            Case Else:
                FileExtStr = ".xlsb": FileFormatNum = 50
        End Select
    End If
    xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
    Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
    Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End Sub

Creates a separately named folder with date, containing all sheet copies. Folder is created in same location as the workbook.

[Tira]

Unfortunately the code wouldn't work at all. Also, I wanted the files to save at the location from above. Here's the error message"Compile error: Wrong number of arguments or invalid property assignment.

[Tira]

Can someone please help me tweak this first code above so that only one sheet is saved per file? Thanks!

[Logit]

.
I am presuming your existing workbook is located in this path and named :

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


If correct, this should work :

Option Explicit


Sub SveShts()


Dim xPath As String
Dim xWs As Worksheet


xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub