My VBA running the macro mutiple times.But need to run only once

Question

I am new to macro. I have written macro code to add the rows based on filter from the macro enabled excel file and copy the results in new excel file.

I have VBS to run the macro. My problem is when I run the macro from the xlsm file ,it is running only once and the values are stored correctly by creating the xlsx file But when I run the same macro from VBS, macro is running multiple times with error msg which is posted below

My Macro is :

Sub SuppOSCalculation()

    Dim wb As Workbook
    Dim src As Worksheet
    Dim tgt As Worksheet
    Dim filterRange As Range
    Dim lastRow As Long
    Dim lastCol As Long
    Dim Total As Double
    Dim AddRange As Range
    Dim c As Variant
    Dim list As Object, item As Variant
    Dim i As Integer
    
    spath = "Mypath\"
    sFile = spath & "supp.xlsm"
    Set wb = Workbooks.Open(sFile)
    SendKeys "{Enter}"
    
    Set src = wb.Sheets("supp")
    Set tgt = wb.Sheets("Sheet3")
    Set list = CreateObject("System.Collections.ArrayList")
   
    i = 2
    ' turn off any autofilters that are already set
    src.AutoFilterMode = False
    
    ' Copy all fileds to second sheet and remove duplicates
    src.Range("C3:C" & Cells(Rows.Count, "C").End(xlUp).Row).Copy tgt.Range("A2")
    tgt.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).RemoveDuplicates Columns:=1, Header:=xlNo
    
    ' Add all values in Second sheet to a list
    With tgt
        For Each item In .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
            If Not list.Contains(item.Value) Then list.Add item.Value
        Next
    End With
    tgt.Range("A1").Value = "Supplier GL Code"
    tgt.Range("B1").Value = "Supplier OS Report-Invoice Amount"
    
        
    ' find the last row and Column with data in column A
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
    lastCol = src.Cells(1, Columns.Count).End(xlToLeft).Column
    
    'MsgBox lastCol
    
    ' the range that we are auto-filtering (all columns)
    Set filterRange = src.Range("A2:AF2" & lastRow)
    
    For Each item In list
       'From List set the value for the filter
       ' MsgBox (item)
        filterRange.Range("C2").AutoFilter field:=3, Criteria1:=item
        
        'Add the column value after applying filter
        Set AddRange = src.Range("P3:P" & src.Range("P" & Rows.Count).End(xlUp).Row)
        Total = WorksheetFunction.Sum(AddRange.SpecialCells(xlCellTypeVisible))
        
        'MsgBox (Total)
       
        tgt.Range("B" & i).Value = Total
        i = i + 1
    Next
    
    'src.AutoFilterMode = False
   
    'wb.Close SaveChanges:=True
   
   
    Dim lRow, lCol As Integer


tgt.Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

For Each cell In Range(Cells(1, "B"), Cells(1, lCol))
Union(Range("A2:A" & lRow), Range(Cells(2, cell.Column), Cells(lRow, cell.Column))).Copy
Workbooks.Add
Range("A1").PasteSpecial
ActiveWorkbook.SaveAs Filename:= _
"SupOSTBCalc\" & cell.Value & ".xlsx" 'You might want to change the extension (.xls) according to your excel version
Next cell

ActiveWorkbook.Close
Application.CutCopyMode = False

   'wb.Close
'   Application.DisplayAlerts = False
'   Application.AlertBeforeOverwriting = False
'   Application.ScreenUpdating = False
'   SendKeys "{Enter}"
    wb.Close savechanges:=False
    
End Sub

VBS is:

Dim xlApp 
  Dim xlBook 

    Set xlApp = CreateObject("Excel.Application") 
    Set xlBook = xlApp.Workbooks.Open("Mypath\SupOSTBCalc.xlsm") 

         xlApp.Run "Module1.SuppOSCalculation"
         'xlBook.Save
         xlBook.Close
         xlApp.Quit 

    Set xlBook = Nothing 
    Set xlApp = Nothing 

Error msg is

Pls help me to solve this.