Copying rows in range based on criteria

I have the following code written but it is not copying the correct cells. I would like to only copy rows in the row range 25:66 with "Buy" in column D and "Initiating" in column E. Can anyone help me modify this code? Thanks in advance.

Private Sub getreport(Code As Integer)

    

    Range("A25").Select
    celltocopy = ("A25:IU25") & ActiveCell.Row
    Range(celltocopy).Select
    Selection.Copy
     If (ActiveCell.Offset(0, 3).Value = "Buy") And (ActiveCell.Offset(0, 4).Value = "Initiating") Then
        Range("A87").Select
        Selection.PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


   End If
   
    Do Until ActiveCell.Value = "Stop"
    OffsetRow = 0
    OffsetRow = OffsetRow + 1
        
    Loop

Hi, the bit of code
celltocopy = ("A25:IU25") & ActiveCell.Row
is creating a variable = A25:IU2525
as activecell.row = 25

try the following:

Dim currcell As Range
n = 0
For Each currcell In Range("A25:A50000")
If currcell <> "STOP" Then Exit For
If currcell.Offset(0, 3) = "Buy" And _
currcell.Offset(0, 4) = "Initiating" Then
currcell.Range("A1:IU1").Copy
Range("A87").Offset(n, 0).PasteSpecial (xlPasteAll)
n = n + 1
End If

Next currcell