How to copy each sheet into a new workbook respectively?

I have a file containing many sheets.

How can I copy each sheets into a new workbook and assign the workbook name same as sheet name?

Thanks

Here's a macro that will copy each sheet in a workbook to a new file and save the file as the worksheet name (be sure to change the file path in BOLD to your own):

Sub createFilesFromSheets()
' Declare variables
Dim ws As Worksheet, mySheet, myPath
myPath = "C:\TEMP"
' Loop through the worksheets in the workbook & create new file for each sheet
For Each ws In ActiveWorkbook.Worksheets
' Get the worksheet name...
mySheet = ws.Name
' Make a copy of the worksheet...
ws.Copy Before:=Worksheets(1)
' Move worksheet to a new file...
Worksheets(1).Move
' Name new worksheet as its' parent...
ActiveSheet.Name = mySheet
' Save the new file...
' Set the file directory to search for previous version...
ChDir myPath
' Delete previous version of the file (if it exists)...
On Error Resume Next
Kill myPath & "\" & mySheet & ".xls"
' Save as Excel file w/Sheet name
ActiveWorkbook.SaveAs Filename:=myPath & "\" & mySheet & ".xls", FileFormat:= _
xlWorkbookNormal, CreateBackup:=False
' Close the new file...
ActiveWindow.Close SaveChanges:=False
Next ws
End Sub

Hope this helps,
theDude