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