Work Books Sheets copy to Multiple WorkBooks and Rename and Save

[nrk]

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

Option Explicit

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

[Paul_Hossler]

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

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