Copying rows in range based on criteria

[rhudgins]

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

[Simon Lloyd]

Try this:
[VBA]Dim Rng As Range, MyCell As Range
Set Rng = Range("A25:A66")
For Each MyCell In Rng
If MyCell.Offset(0, 3).Value = "Buy" And MyCell.Offset(0, 4).Value = "Initiating" Then
MyCell.EntireRow.Copy
Range("A86").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next MyCell
Application.CutCopyMode = False[/VBA]

[rhudgins]

That works but instead of pasting the rows starting in row 87 it starts pasting in row 80. I tried changing the range("A86") to range("A87") but then the macro continuosly copies and pastes into row 87

[Simon Lloyd]

Use this instead:
[VBA]Dim Rng As Range, MyCell As Range, i As Long
Set Rng = Range("A1:A66")
i = 87
For Each MyCell In Rng
If MyCell.Offset(0, 3).Value = "Buy" And MyCell.Offset(0, 4).Value = "Initiating" Then
MyCell.EntireRow.Copy
Range("A" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
End If
Next MyCell
Application.CutCopyMode = False[/VBA]

[rhudgins]

Thanks! I adjusted what you just wrote to ("A25:A66') and it works perfectly.

[rhudgins]

One more question. I would like to reference AF3 and AG3 instead of writing in "Buy" and "Initiating" how can this be done?

[Simon Lloyd]

Use this:
[VBA]Dim Rng As Range, MyCell As Range, i As Long
Set Rng = Range("A25:A66")
i = 87
For Each MyCell In Rng
If MyCell.Offset(0, 3).Value = Range("AF3").Value And MyCell.Offset(0, 4).Value = Range("AF4").Value Then
MyCell.EntireRow.Copy
Range("A" & i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
i = i + 1
End If
Next MyCell
Application.CutCopyMode = False[/VBA]

[rhudgins]

Thanks!

[rhudgins]

Can you help me finish this macro?

If you run the macro in my sheet it copies and pastes the data for the first example. I need the macro to loop through every example 1 through 5 (AE3:AE7) based on the criteria