Sub myDatainWorkSheetToworkbook()
Dim myData As String
myData = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each mysheet In ThisWorkbook.Sheets
mysheet.Copy
Application.ActiveWorkbook.SaveAs Filename:=myData & "\" & myshet.Nam & ".xlsx"
Application.ActiveWorkbook.Close
Next
End Sub