VBA: Send each worksheet to a new workbook...

[Benzoli7]

Hello,

Can anyone help me with some code that will save each sheet in a workbook as a new workbook in a specified folder? I would like for the newly created workbooks to be named after the sheet that creates them. Also, is there any way to make the new workbooks only have the sheet that creates them?

The file path for the folder that I want to house them is:

G:\Trans\Fall 2011 Bid\Responses

Thanks for the help. I am a little overwhelmed and can't wrap my head around how to get started. There are 190+ worksheets that need to be made into new workbooks.

Thanks so much.

 

[JoeMo]

What file extension do you want to use on the new workbooks (i.e .xls or .xlsx, or .xlsm, ...)?

 

[Benzoli7]

.xls I think. I want it to be compatible with as many versions of Excel as possible.

 

[JoeMo]

Try this on a copy of your workbook (or maybe an abbreviated copy with only a few sheets in it). Note that a workbook must have at least one sheet so when the code has reduced the source workbook to one sheet, it saves that sheet as a new book and leaves that new workbook open. The original workbook will no longer be open. It will be in its folder unchanged from when the macro was initiated.

Sub CreateNewBooksFromSheets()
Dim sB As Workbook, sSh As Worksheet, mShts As Long, sShts As Long
Const fPath = "G:\Trans\Fall 2011 Bid\Responses"
Set sB = ThisWorkbook
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
sShts = sB.Sheets.Count
For i = sShts To 2 Step -1
    sB.Sheets(i).Move
    With ActiveWorkbook
        mShts = .Sheets.Count
        For j = mShts To 2 Step -1
            .Sheets(j).Delete
        Next j
        .SaveAs fPath & Application.PathSeparator & _
            .Sheets(1).Name & ".xls", FileFormat:=xlExcel8, _
            Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
        .Close
    End With
Next i
With sB
    .SaveAs fPath & Application.PathSeparator & .Sheets(1).Name _
        & ".xls", FileFormat:=xlExcel8, Password:="", _
        WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
End With
End Sub

 

[JoeMo]

Sorry, forgot that you requested only one sheet in each new workbook created. Ignore my last post and go with the code below. I suggest you run the code from the View Macros menu rather than placing a macro button within the originating workbook. The code below is set up so it makes a new workbook for every sheet in the originating workbook; it saves each workbook and closes it. After the macro completes, the originating workbook will be closed and in its original folder, unchanged from its state before the macro was executed. All one-sheet new workbooks will be in the same folder, all with .xls file extensions.

Sub CreateNewBooksFromSheets()
Dim sB As Workbook, sSh As Worksheet, mShts As Long, sShts As Long
Const fPath = "G:\Trans\Fall 2011 Bid\Responses"
Set sB = ThisWorkbook
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With
sShts = sB.Sheets.Count
For i = sShts To 2 Step -1
    sB.Sheets(i).Move
    With ActiveWorkbook
        mShts = .Sheets.Count
        If mShts > 1 Then
            ActiveSheet.Move before:=Sheets(1)
            For j = mShts To 2 Step -1
                .Sheets(j).Delete
            Next j
        End If
        .SaveAs fPath & Application.PathSeparator & _
            .Sheets(1).Name & ".xls", FileFormat:=xlExcel8, _
            Password:="", WriteResPassword:="", _
            ReadOnlyRecommended:=False, CreateBackup:=False
        .Close
    End With
Next i
With sB
    .SaveAs fPath & Application.PathSeparator & .Sheets(1).Name _
        & ".xls", FileFormat:=xlExcel8, Password:="", _
        WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
    .Close
End With
End Sub

 

[Benzoli7]

Wow...Amazing Thank you so much. That worked perfectly.

Can you recommend a place for me to go to learn about creating loops like this?

 

[JoeMo]

Wow...Amazing Thank you so much. That worked perfectly.

Can you recommend a place for me to go to learn about creating loops like this?

There are lots of web sites with good, free info - just google VBA for Excel tutorial.