Looping through specific sheets in VBA and copy/paste-CodePudding

I am trying to loop through specific sheets in Excel and have the formula in A1 paste through the last row of data. The code below works for the first sheet that is listed, however, it does not carry over to subsequent worksheets.

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

CodePudding user response：

Copy Formula in Multiple Worksheets

Qualify the objects: the ranges (dws.Range..., gws.Range...) and the worksheets (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