Deleting multiple worksheets and saving active worksheet

[singcbl]

I am trying to find a easy way to delete multiple worksheets in a workbook and then saving the workbook based on the tab name of the worksheet.

 

[zzjasonzz]

are the names always the same of the sheets you want to delete/rename?

    Application.DisplayAlerts = False
    Sheets(Array("Sheet2", "Sheet3")).Delete
    Application.DisplayAlerts = True

    savedir = "C:\Documents and Settings\My Documents\"
    ActiveWorkbook.SaveAs Filename:= _
        savedir & ActiveSheet.Name & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

 

[singcbl]

Yes, the name will always be the same as the tab

 

[singcbl]

zzjasonzz,

Tried running your codes and I got a error message, "Subscript out of range" and the code stop at

Sheets(Array("Sheet1", "Sheet2")).Delete

any idea what is wrong?

 

[singcbl]

zzjasonzz,

Tried running your codes and I got a error message, "Subscript out of range" and the code stop at

Sheets(Array("Sheet1", "Sheet2")).Delete

any idea what is wrong? For your information the workbook contains sheet named as "summary", " action list", "Title", "Inf001", "Inf002" ..... "Inf050"

 

[jindon]

singcbl

1) how many worksheets do you want to save as new workbook?

2) what are the name(s) of the worksheet that you want to save?

 

[singcbl]

Jindon-san,

I just need to save the selected worksheet or worksheets and the name of the to be saved workbook should be the same name as the selected worksheet or worksheet. If multiple selection is not possible then just the active worksheet is fine

 

[jindon]

for the single sheet selection
try

Sub test()
Dim myPath As String, NewName As String
myPath = ThisWorkbook.Path
With ActiveSheet
     NewName = .Name
     .Copy
End With
ActiveWorkbook.SaveAs myPath & "\" & NewName & ".xls"
End Sub

 

[singcbl]

Jindon-san,

I tried running the codes and it appear to work as it should be, but what surprises me is that the macro modules that were with the original workbook were not copied over as well. My primary objective is to ensure that those modules are copied over.

 

[jindon]

Then try

Sub test()
Dim myPath As String, NewName As String, ws As Worksheet
myPath = ThisWorkbook.Path
NewName = ActiveSheet.Name
Application.displayAlerts = False
For Each ws In Sheets
     If ws.Name <> NewName Then ws.Delete
Next
Thisworkbook.SaveAs myPath & NewName & ".xls"
End Sub