复制列中具有特定文本的行 VBA Excel

Question

I am very new to VBA and all coding so I'm not very good at even the basics yet.

I have a worksheet in excel with about a dozen different business' Balance Sheets. I need to copy all of the the rows in a specific range based on the Asset name in column D. The specific range I need to copy is in between "Securities" and "Derivatives."

I successfully copied all the lines of data in between the first set of "Securities" and "Derivatives" but my For Loop keeps copying the same first range when I need it to move to the next set of "Securities" and "Derivatives" Data.

I have tried and thought maybe adding a variable to my rngA might work? Any help is appreciated.

'''
    
Sub ChartReference2()
    Dim findrow As Long

    Dim findrow2 As Long
    Dim rngA As Range
    
    
    For Each cell In ActiveWorkbook.Worksheets("BS growth").Range("A:A")
        If cell.Value = "Asset" Then
            Worksheets("BS growth").Activate
            findrow = Range("D:D").Find("Securities", Range("D3")).Row
            findrow2 = Range("D:D").Find("Derivatives", Range("D" & findrow)).Row
            Range("D" & findrow & ":D" & findrow2, Selection.End(xlToRight)).Select
            Selection.Copy
    
    End If
    Next cell
    
    
    End Sub

'''

Answer 1

Try this - comments in-line

Sub ChartReference2()
    
    Dim ws As Worksheet, assetRow, f1 As Range, f2 As Range
    
    Set ws = ActiveWorkbook.Worksheets("BS growth")
    
    assetRow = Application.Match("Asset", ws.Columns("A"), 0)
    If Not IsError(assetRow) Then 'matched a cell in Col A?
        With ws.Columns("D")
            Set f1 = .Find("Securities", lookat:=xlWhole, after:=.Cells(assetRow - 1), _
                            SearchDirection:=xlNext)
            If Not f1 Is Nothing Then      'found the value?
                Set f2 = .Find("Derivatives", lookat:=xlWhole, after:=f1, _
                                SearchDirection:=xlNext)
                If Not f2 Is Nothing Then  'found the value?
                    ws.Range(f1, f2).Copy  'copy range
                End If
            End If
        End With
    End If
End Sub