Saving Individual Sheets with Tab Name as New Workbooks

[thelostscott]

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

 

[Jon von der Heyden]

Hello and welcome to the board!

Something like this?

[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]

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?