VBA to Extract Worksheets from a single workbook putting each in its own workbook

[BGDunbar]

I have an Excel workbook with approximately 20 worksheets in it. I want each worksheet to have it's own workbook named as the worksheet tab is named (tab name "District 01", file name "District 01") in same folder. I want to keep the original workbook intact as well so these would be copies of worksheets. I do this on a monthly basis so would like to automate. Is there a way to automate with VBA?

All help is appreciated.
Thank you,
Betty

 

[My Aswer Is This]

Try this:
Will save each Sheet in workbook into separate workbooks saving Workbook as sheet name in the active workbook Path.

Sub Add_Workbook()
Application.ScreenUpdating = False
Dim ans As String
ans = ActiveWorkbook.Name
Dim FileName As String
Dim FilePath As String
Dim i As Long
FilePath = ThisWorkbook.Path
For i = 1 To Sheets.Count
    FileName = Sheets(i).Name
    Application.Workbooks.Add
    ActiveWorkbook.SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=52
    Workbooks(ans).Sheets(i).Copy After:=Sheets(Sheets.Count)
    Application.DisplayAlerts = False
    ActiveWorkbook.Sheets(1).Delete
    Application.DisplayAlerts = True
    ActiveWorkbook.Save
    ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
MsgBox "All Done"
End Sub

 

[BGDunbar]

Thank you My Answer Is This. Everything works except the file path for saving the individual workbooks. I am on a network so I'm not sure if that makes a difference. The file is on the network but the individual workbooks wound up on my hard drive which I rarely use. I discovered this when I tried to run the code a second time and got the message about there already being a file there with that name and gave me the path to find them.

If you can get it to save to the network it would be great. If not, I can work with it this way.

Thank you for your quick response.
Betty

 

[Fluff]

Hia
Give this a go

Sub SplitWb()

    Dim ws As Worksheet
    Dim Pth As String
    
Application.ScreenUpdating = False

    Pth = ActiveWorkbook.Path & "\"
    
    For Each ws In Worksheets
        ws.Copy
        ActiveWorkbook.SaveAs Pth & ws.Name, FileFormat:=51
        ActiveWorkbook.Close
    Next ws

End Sub

 

[My Aswer Is This]

I would need to know the Proper path.

Thank you My Answer Is This. Everything works except the file path for saving the individual workbooks. I am on a network so I'm not sure if that makes a difference. The file is on the network but the individual workbooks wound up on my hard drive which I rarely use. I discovered this when I tried to run the code a second time and got the message about there already being a file there with that name and gave me the path to find them.

If you can get it to save to the network it would be great. If not, I can work with it this way.

Thank you for your quick response.
Betty

 

[BGDunbar]

Thank you Fluff. It works wonderfully. I appreciate your help also My Answer Is This...

 

[Fluff]

Glad we could help & thanks for the feedback

Not quit sure why M.A.I.T's code didn't work correctly, as it worked fine for me.

 

[My Aswer Is This]

My script would work on your own computer you said but not on the Network. You never said anything in your original post about wanting files saved on a Network.

Thank you Fluff. It works wonderfully. I appreciate your help also My Answer Is This...