code is very good and close, but might I suggest the following
modifications for it to work right:



Sub Extract_Current_Sheet_to_File()

Dim wsToSave As Worksheet

Dim strName As String

On Error Resume Next

strName = ActiveSheet.[a1]

Set wsToSave = Sheets(strName)

If wsToSave Is Nothing Then

MsgBox "There is no sheet  named " & strName & "."

Exit Sub

End If

Application.ScreenUpdating = False

wsToSave.Copy ' copy  this sheet to a new workbook, must use no
parameters

' should do some error checking here:

ActiveWorkbook.SaveAs Filename:=strName ' save  the new workbook

ActiveWorkbook.Close

'or in do the SaveAs and Close in one statement:

'ActiveWorkbook.Close SaveChanges:=True, Filename:=strName

Application.ScreenUpdating = True

If Dir(strName & ".xls") <> vbNullString Then

MsgBox strName & " was saved successfully"

Else

MsgBox strName & " was NOT saved successfully"

End If

End Sub