Create another file but don't split worksheets into separate files - excel

Question

Separate worksheets into separate files
Hi I am using code
Sub Split_Sheet_into_ExcelFiles()
Dim FilePath As String
FilePath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Sheet In ThisWorkbook.Sheets
Sheet.Copy
Application.ActiveWorkbook.SaveAs Filename:=FilePath & "\" & Sheet.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
It creates the same file but I was trying to split multiple worksheets into individual files. ANy idea what I'm typing wrong? Thanks

Answer 1

Export Each Sheet to an Individual File
Option Explicit
Sub ExportSheets()
Const PROC_TITLE As String = "Export Sheets"
Dim swb As Workbook: Set swb = ThisWorkbook ' workbook containing this code
Dim dFilePath As String: dFilePath = swb.Path
If Len(dFilePath) = 0 Then
MsgBox "The path cannot be determined." & vbLf & "Please save the " _
& "workbook before using this procedure.", vbCritical, PROC_TITLE
Exit Sub
End If
Application.ScreenUpdating = False
Dim dwb As Workbook, ssh As Object, sshCount As Long
For Each ssh In swb.Sheets
If ssh.Visible = xlSheetVisible Then ' sheet is visible
ssh.Copy
Set dwb = Workbooks(Workbooks.Count)
Application.DisplayAlerts = False ' overwrite without confirmation
dwb.SaveAs Filename:=dFilePath & "\" & ssh.Name
Application.DisplayAlerts = False
dwb.Close SaveChanges:=False
sshCount = sshCount + 1
'Else ' sheet is not visible; do nothing!?
End If
Next ssh
Application.ScreenUpdating = True
MsgBox sshCount & " sheet" & IIf(sshCount = 1, "", "s") _
& " exported.", vbInformation, PROC_TITLE
End Sub