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

BGDunbar

Board Regular
Joined
Jul 26, 2016
Messages
79
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
 
Last edited:

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,743
Office Version
2013
Platform
Windows
Try this:
Will save each Sheet in workbook into separate workbooks saving Workbook as sheet name in the active workbook Path.

Code:
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

Board Regular
Joined
Jul 26, 2016
Messages
79
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,544
Office Version
365
Platform
Windows
Hia
Give this a go
Code:
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

Well-known Member
Joined
Jul 5, 2014
Messages
16,743
Office Version
2013
Platform
Windows
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

Board Regular
Joined
Jul 26, 2016
Messages
79
Thank you Fluff. It works wonderfully. I appreciate your help also My Answer Is This...

:)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
38,544
Office Version
365
Platform
Windows
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.
 
Last edited:

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,743
Office Version
2013
Platform
Windows
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...

:)
 

Watch MrExcel Video

Forum statistics

Threads
1,095,322
Messages
5,443,785
Members
405,251
Latest member
shanezer

This Week's Hot Topics

Top