How can I make this VBA loop througt all sheetstabs
Option Explicit
Sub TEST()
Dim a As Long, arr As Variant, fnd As Range, cpy As Range, addr As String
On Error GoTo Err_Execute
‘populate the array for the outer loop
arr = Array(“Total Revenue”, “Net Revenue to the WI Owners”, “Total WI Expenses”, “Average $ per BBL”)
With Worksheets(“sheet1”)
‘outer loop through the array
For a = LBound(arr) To UBound(arr)
‘locate first instance
Set fnd = .Columns(“B”).Find(what:=arr(a), LookIn:=xlFormulas, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not fnd Is Nothing Then
‘record address of first find
addr = fnd.Address
‘seed the cpy range object
If cpy Is Nothing Then Set cpy = fnd.EntireRow
Do
‘build union
Set cpy = Union(cpy, fnd.EntireRow)
‘look for another
Set fnd = .Columns(“B”).FindNext(after:=fnd)
‘keep finding new matches until it loops back to the first
Loop Until fnd.Address = addr
End If
Next a
End With
With Worksheets(“sheet2”)
‘one stop copy & paste operation
cpy.Copy Destination:=.Cells(.Rows.Count, “A”).End(xlUp).Offset(1, 0)
End With
Exit Sub
Err_Execute:
Debug.Print Now & ” ” & Err.Number & ” – ” & Err.Description
End Sub
By: Al