Spliting the selected worksheets to a seperate workbooks

Sameer_Kuppanath_Sultan 

Try this version:

Sub SplitWorkbook()
    'Updateby20200806
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim xWs As Worksheet
    Dim xWb As Workbook
    Dim xNWb As Workbook
    Dim FolderName As String
    Dim arrSheets() As Worksheet
    Application.ScreenUpdating = False
    Set xWb = Application.ThisWorkbook
    Dim i As Long
    Dim n As Long
    Dim DateString As String
    Dim xFile As String

    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = xWb.Path & "\" & xWb.Name & " " & DateString

    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

    MkDir FolderName

    n = ActiveWindow.SelectedSheets.Count
    ReDim arrSheets(1 To n)
    For i = 1 To n
        Set arrSheets(i) = ActiveWindow.SelectedSheets(i)
    Next i

    For i = 1 To n
        On Error GoTo NErro
        Set xWs = arrSheets(i)
        xWs.Select
        xWs.Copy
        xFile = FolderName & "\" & xWs.Name & FileExtStr
        Set xNWb = Application.Workbooks.Item(Application.Workbooks.Count)
        xNWb.SaveAs xFile, FileFormat:=FileFormatNum
        xNWb.Close False
NErro:
        xWb.Activate
    Next i

    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
End Sub