我正在嘗試遍歷 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
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/408251.html
標籤：