我正在尝试遍历 Excel 中的特定作业表，并将 A1 中的公式粘贴到最后一行资料中。下面的代码适用于列出的第一张作业表，但是，它不会延续到后续作业表。

Sub Refresh_ActivesheetB36()

Dim lastrow As Long
Dim MyArray As Variant
Dim i As Integer

Application.ScreenUpdating = False

Sheets("GroupInfo").Select
    Range("B36").Select
    Selection.Formula = "=COUNTIF('TAX INFO'!E15:E1499,"">0"")"
    
MyArray = Array("DATA Member", "DATA Sch A")

With Worksheets(MyArray)
    lastrow = Cells(Rows.Count, "D").End(xlUp).Row
End With

On Error Resume Next
For i = LBound(MyArray) To UBound(MyArray)
    With Worksheets(MyArray(i))
        Range("A1").Select
        Range("A1:A" & lastrow).PasteSpecial
    End With
    Next i
On Error GoTo 0
            
Application.ScreenUpdating = True
  Worksheets("GroupInfo").Select
    
End Sub

uj5u.com热心网友回复：

在多个作业表中复制公式

• 限定物件：范围 ( dws.Range..., gws.Range...) 和作业表 ( wb.Worksheets...)。

Option Explicit

Sub Refresh_ActivesheetB36()

    Dim dwsNames As Variant: dwsNames = Array("DATA Member", "DATA Sch A")

    Application.ScreenUpdating = False

    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim gws As Worksheet: Set gws = wb.Worksheets("GroupInfo")
    gws.Range("B36").Formula = "=COUNTIF('TAX INFO'!E15:E1499,"">0"")"

    Dim dws As Worksheet
    Dim dlRow As Long
    Dim d As Long
    
    For d = LBound(dwsNames) To UBound(dwsNames)
        On Error Resume Next
        Set dws = wb.Worksheets(dwsNames(d))
        On Error GoTo 0
        If Not dws Is Nothing Then
            dlRow = dws.Range("D" & dws.Rows.Count).End(xlUp).Row
            dws.Range("A1").Copy dws.Range("A1:A" & dlRow)
            Set dws = Nothing
        End If
    Next d
    
    Application.ScreenUpdating = True
    gws.Activate

End Sub