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

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.