Saving Individual Sheets with Tab Name as New Workbooks

thelostscott

Board Regular
Joined
May 7, 2010
Messages
226
Hi all,

Need some help if you are willing to share your gifts....

I have a Workbook that has multiple sheets in it that I need to then seperate into individual Workbooks saving the files as the same name as what is on the current tab. I would be looking at doing this for around 40-odd sheets.

What I have so far is this:

Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1:J72").Select

Selection.Copy

Workbooks.Add

ActiveSheet.Paste

ActiveWindow.SmallScroll Down:=-33

Range("L8").Select

Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _
""S:\****\****\****\****\****\****\15.xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

Windows("*******************.xls").Activate
Range("M73").Select

Sheets(Array(15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58)).Select

ActiveWindow.SmallScroll Down:=-60

Range("A1:J72").Select

Selection.Copy

Workbooks.Add

ActiveSheet.Paste

Range("F7").Select

Application.CutCopyMode = False

ActiveWorkbook.SaveAs Filename:= _
"S:\****\****\****\****\****\****\15.xls" _
, FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub


* So I take it I would have to put in a "ActiveWorkbook.SaveAs Filename:=Activesheet.name" somewhere?

* This is also done just by recording a Macro, however I adjusted the Array to select the individual sheets
 

Some videos you may like

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Jon von der Heyden

MrExcel MVP, Moderator
Joined
Apr 6, 2004
Messages
10,808
Office Version
  1. 365
Platform
  1. Windows
Hello and welcome to the board!

Something like this?

Code:
[COLOR=blue]Public[/COLOR] [COLOR=blue]Sub[/COLOR] MakeFiles()
    [COLOR=blue]Dim[/COLOR] lngSheet [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]
    [COLOR=blue]Const[/COLOR] strPath [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR] = "C:\" [COLOR=green]'change to your desired directory path[/COLOR]
 
    [COLOR=blue]For[/COLOR] lngSheet = 15 [COLOR=blue]To[/COLOR] 58
        Sheets(lngSheet).Copy
        [COLOR=blue]With[/COLOR] ActiveWorkbook
            .SaveAs strPath & .Sheets(1).Name & ".xls"
            .Close [COLOR=blue]False[/COLOR]
        [COLOR=blue]End[/COLOR] [COLOR=blue]With[/COLOR]
    [COLOR=blue]Next[/COLOR] lngSheet
 
[COLOR=blue]End[/COLOR] [COLOR=blue]Sub[/COLOR]
 

thelostscott

Board Regular
Joined
May 7, 2010
Messages
226
Legend! Thanks for that it works a treat, but how do I get it only to copy over the data from A1:J72 only in the new sheets?
 

Watch MrExcel Video

Forum statistics

Threads
1,122,710
Messages
5,597,702
Members
414,164
Latest member
ARTW

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top