Clerk

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

Leave a Reply

Your email address will not be published. Required fields are marked *