Try something like this (no error handling):

'*********************************************
Option Explicit

Sub Extract_Current_Sheet_to_File()
Dim ws As Object
Dim strName As String
Dim strFN As String
Set ws = ActiveSheet
strName = ws.[a1]
strFN = strName & "xls"

Application.ScreenUpdating = False
Workbooks.Add
ws.Copy Before:=Sheets(1)
ActiveSheet.Name = strName
ActiveWorkbook.SaveAs Filename:=strFN, FileFormat:=xlNormal
Workbooks(strFN).Close
Application.ScreenUpdating = True
End Sub