简体   繁体   中英

Looping through specific sheets in VBA and copy/paste

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

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM