VBA Script to split all worksheets in a workbook to separate files

Question

I have a script that does a vlookup for each sheet in workbook and then splits each worksheet into its own file. I have the below script, but it is not working. The vlookup portion is working fine, but I am having issues with the split. It doesn't fail and give me an error, it just doesn't do anything.

Sub Splitbook()
MyPath = "***Folder Location***"
For Each sht In Workbooks("PO135 Division 1.xlsx").Worksheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub

I need to split the files and then save them in a distinct folder(" Folder Location ")--this is just a placeholder for the time being, it would be updated prior to running the script--

Any thoughts? Appreciate the help!

Answer 1

Put this in a regular module:

Sub NewWb()
Dim ws As Worksheet
Dim wbActive As Workbook
Dim wbNew As Workbook
Dim x As Single
Application.ScreenUpdating = False
    Set wbActive = ActiveWorkbook

    For Each ws In wbActive.Worksheets
        Set wbNew = Workbooks.Add
        ws.Copy Before:=wbNew.Sheets(1)
        abc = "C:\Files\" & ws.Name & ".xlsx"
        Application.DisplayAlerts = False
        wbNew.Sheets("Sheet1").Delete
        Application.DisplayAlerts = True
        wbNew.SaveAs Filename:=abc
        wbNew.Close Saved = True
    Next ws
    Set ws = Nothing
    Set wbActive = Nothing
    Set wbNew = Nothing
    Application.ScreenUpdating = True    
End Sub