Excel VBA to Export Sheets to Seperate Files

Export Sheets to Files
======================================
Option Explicit
Dim MainWorkBook As Workbook
Dim NewWorkBook As Workbook
Sub ExportWorksheet()
Dim Pointer As Long
Dim Filepath As String
Dim strFolder As String
Filepath = ActiveWorkbook.Path

Set MainWorkBook = ActiveWorkbook
'''''''''''''''''''''''''Display number of worksheets
'Range("E2").Value = MainWorkBook.Sheets.Count
Application.ScreenUpdating = False   'enhance the performance
For Pointer = 2 To MainWorkBook.Sheets.Count
    Set NewWorkBook = Workbooks.Add
    MainWorkBook.Sheets(Pointer).Copy After:=NewWorkBook.Sheets(1)
    Application.DisplayAlerts = False
    NewWorkBook.Sheets(1).Delete
    Application.DisplayAlerts = True
    ''''''''''''''''''''''Save new work sheets
   
    strFolder = Filepath & "\" & "ExportedSheets"
 '''''''''''''''''''''''''Create dierctory if not present

 If Dir(strFolder, vbDirectory) = "" Then MkDir strFolder
   
    With NewWorkBook
       
        '.SaveAs Filename:=Filepath & "\" & "Sheets" & "\" & MainWorkBook.Sheets(Pointer).Name & ".xlsx"
        .SaveAs Filename:=strFolder & "\" & MainWorkBook.Sheets(Pointer).Name & ".xlsx"
     
    End With
    NewWorkBook.Close SaveChanges:=True
Next Pointer
Application.ScreenUpdating = True
'''''''''''''''Optional Display Message
'Range("D5").Value = "Export Completed"
'MsgBox "Done"
Shell "explorer.exe " & strFolder, vbNormalFocus
End Sub
------------------------------------------------