excel - 我的 VBA 多次运行宏。但只需要运行一次

Question

我是宏的新手。我已经编写了宏代码来添加基于启用宏的 excel 文件中的过滤器的行，并将结果复制到新的 excel 文件中。

我有 VBS 来运行宏。我的问题是当我从 xlsm 文件运行宏时，它只运行一次，并且通过创建 xlsx 文件正确存储了值但是当我从 VBS 运行相同的宏时，宏运行多次，错误消息已发布以下

我的宏是：

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 是：

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 

错误消息是

请帮我解决这个问题。

标签： excelvbavbscript