Work Books Sheets copy to Multiple WorkBooks and Rename and Save

I have workbook and there many sheets i want to copy one by one sheets to new work book and rename workbook and save except first sheet
I tried many times, but it saved in one workbook instead of separate workbooks

Code:

---

Option Explicit

---

Code:

---


Sub CreateWorkBooks()
    Dim ws AsObject
    Dim i AsLong
    Dim ws_num AsInteger
    Application.ScreenUpdating =False

    Set ws = Worksheets
    ws_num = ThisWorkbook.Worksheets.Count

    For i =2To ws_num
        'Copy one worksheet as a new workbook
        'The new workbook becomes the ActiveWorkbook
        ws.Copy

        'Replace all formulas with values (optional)
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

        'May want (not required) to add a file name extension (.xls or .xlsx) to the file name
        ActiveWorkbook.SaveAs ThisWorkbook.Path &"\"& _
          "AR Balance- "& ActiveSheet.Name &" "& Worksheets("DATA Sheet").Range("m2")&".xlsx"
        ActiveWorkbook.Close SaveChanges:=False
    Next

    Application.ScreenUpdating =True
EndSub

---

I'd do something like this

I don't like to rely on sheet numbers (e.g. 'the 'first sheet') being what I think they are -- safer to use .Name

Added deleting output workbooks if they already exist

Code:

---

Option Explicit
Sub CreateWorkBooks()
    Dim ws As Worksheet
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sFilename As String, sM2 As String
   
    Application.ScreenUpdating = False
    Set wb1 = ThisWorkbook
    sM2 = wb1.Worksheets("DATA").Range("M2")
   
    For Each ws In wb1.Worksheets
       
        If ws.Name = "DATA" Then GoTo GetNext
       
        'Copy one worksheet as a new workbook
        'The new workbook becomes the ActiveWorkbook
        ws.Copy
       
        Set wb2 = ActiveWorkbook
       
        'Replace all formulas with values (optional)
        ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value

        'May want (not required) to add a file name extension (.xls or .xlsx) to the file name
        sFilename = wb1.Path & "\" & "AR Balance- " & ActiveSheet.Name & " " & sM2 & ".xlsx"
       
        On Error Resume Next
        Application.DisplayAlerts = False
        Kill sFilename
        Application.DisplayAlerts = True
        On Error GoTo 0
       
       
        wb2.SaveAs sFilename, xlOpenXMLWorkbook
        wb2.Close SaveChanges:=False
       
        wb1.Activate
GetNext:
    Next
    Application.ScreenUpdating = True
End Sub

---