Pfthb

Sub SplitWorkbook()
'Updateby20140612
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim xWs As Worksheet
Dim xWb As Workbook
Dim FolderName As String
Application.ScreenUpdating = False
Set xWb = Application.ThisWorkbook
DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
FolderName = xWb.Path & "" & xWb.Name & " " & DateString
MkDir FolderName
For Each xWs In xWb.Worksheets
 xWs.Copy
 If Val(Application.Version) < 12 Then
 FileExtStr = ".xls": FileFormatNum = -4143
 Else
 Select Case xWb.FileFormat
 Case 51:
 FileExtStr = ".xlsx": FileFormatNum = 51
 Case 52:
 If Application.ActiveWorkbook.HasVBProject Then
 FileExtStr = ".xlsm": FileFormatNum = 52
 Else
 FileExtStr = ".xlsx": FileFormatNum = 51
 End If
 Case 56:
 FileExtStr = ".xls": FileFormatNum = 56
 Case Else:
 FileExtStr = ".xlsb": FileFormatNum = 50
 End Select
 End If
 xFile = FolderName & "" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
 Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
 Application.ActiveWorkbook.Close False
Next
MsgBox "You can find the files in " & FolderName
Application.ScreenUpdating = True
End enter code here

when use I run this code, I encountered error on the line 14 "xWs.Copy" with an msg "run time error '1004' Method 'copy' of object'_worksheet failed.
Is there any way to short this lengthy formula?
All I just want is to export current workbook with different number of sheets to individual workbook with 1 sheet in it.