How to save the Active Excel Workbook as a different list of names in the location of the Active Workbook

[Guna13]

I tried to save my Active work with .Xlsm but I got an Out of Memory error or my Active work was automatically closed. Can't accomplish this task?
As a result of making multiple .Xlsm workbooks. The end user will update the information, then run the final macro. I need to keep this active workbook module.Code in split files as well.

Sub FileSplit()

Set ws = ThisWorkbook.Worksheets("Segment TB workings")
    On Error Resume Next
    ThisWorkbook.Sheets("Sdata").Delete
    On Error GoTo 0
    
    ws.Activate
    ws.AutoFilterMode = False
    Dim i As Long, sh As Worksheet, sh2 As Worksheet
    Set sh2 = Sheets.Add(After:=ws)
    sh2.Name = "Sdata"
    Sheets("Segment TB workings").Range("O1:O100000").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Sheets("Sdata").Range("A1"), CopyToRange:=Range("A1"), _
    Unique:=True
    
        lr = Cells(Rows.Count, "A").End(xlUp).Row 'find last row
        For i = lr To 2 Step -1 'loop thru backwards, finish at 2 for headers
            If Cells(i, "A").Text = "#N/A" Then Rows(i).EntireRow.Delete
        Next i
    
     numrows = Range("A2", Range("A2").End(xlDown)).Rows.Count
     i = 2
    Do Until i > numrows
    Set IndName = Worksheets("Sdata").Cells(i, 1)
    
    With ActiveWorkbook
    
    .SaveAs Filename:="C:\Statutory Audit Report\SourceFiles\" & IndName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    .Close 0
    End With
    i = i + 1
    Loop       
    End Sub

 

[rlv01]

What about something like this? (not tested)

Sub FileSplit()
    Dim WS As Worksheet, LR As Long, NumRows As Long, IndName As String

    Set WS = ThisWorkbook.Worksheets("Segment TB workings")
   
    On Error Resume Next
    ThisWorkbook.Sheets("Sdata").Delete
    On Error GoTo 0

    WS.Activate
    WS.AutoFilterMode = False
   
    Dim i As Long, sh As Worksheet, sh2 As Worksheet
    Set sh2 = Sheets.Add(After:=WS)
    sh2.Name = "Sdata"
    Sheets("Segment TB workings").Range("O1:O100000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Sdata").Range("A1"), CopyToRange:=Range("A1"), Unique:=True

    LR = Cells(Rows.Count, "A").End(xlUp).Row         'find last row
    For i = LR To 2 Step -1                           'loop thru backwards, finish at 2 for headers
        If Cells(i, "A").Text = "#N/A" Then Rows(i).EntireRow.Delete
    Next i

    NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
    i = 2
    Do Until i > NumRows
        IndName = Worksheets("Sdata").Cells(i, 1).Value

        With ActiveWorkbook
            .SaveCopyAs Filename:="C:\Statutory Audit Report\SourceFiles\" & IndName
             DoEvents
            '.SaveAs Filename:="C:\Statutory Audit Report\SourceFiles\" & IndName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            '.Close 0
        End With
        i = i + 1
    Loop
End Sub

 

[Guna13]

What about something like this? (not tested)

Sub FileSplit()
    Dim WS As Worksheet, LR As Long, NumRows As Long, IndName As String

    Set WS = ThisWorkbook.Worksheets("Segment TB workings")
  
    On Error Resume Next
    ThisWorkbook.Sheets("Sdata").Delete
    On Error GoTo 0

    WS.Activate
    WS.AutoFilterMode = False
  
    Dim i As Long, sh As Worksheet, sh2 As Worksheet
    Set sh2 = Sheets.Add(After:=WS)
    sh2.Name = "Sdata"
    Sheets("Segment TB workings").Range("O1:O100000").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Sdata").Range("A1"), CopyToRange:=Range("A1"), Unique:=True

    LR = Cells(Rows.Count, "A").End(xlUp).Row         'find last row
    For i = LR To 2 Step -1                           'loop thru backwards, finish at 2 for headers
        If Cells(i, "A").Text = "#N/A" Then Rows(i).EntireRow.Delete
    Next i

    NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
    i = 2
    Do Until i > NumRows
        IndName = Worksheets("Sdata").Cells(i, 1).Value

        With ActiveWorkbook
            .SaveCopyAs Filename:="C:\Statutory Audit Report\SourceFiles\" & IndName
             DoEvents
            '.SaveAs Filename:="C:\Statutory Audit Report\SourceFiles\" & IndName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            '.Close 0
        End With
        i = i + 1
    Loop
End Sub

I used this SavecopyAs instead of SaveAs, but i need to save this all file based on Respective data instead of same master data no need to save different name . what to do sir.

 

[rlv01]

No idea what "respective data" means or why it is relevant to anything. The loop structure in your original post suggests you are attempting to create multiple files based on the changing variable IndName and SaveCopyAs is a better choice for that then SaveAs. But unless you have something within the Do...Until loop that actually changes any cells, all the new files will be copies of the master. My suggestion would be to provide a more comprehensive description of what you are trying to do.