如何基于2个单元格的百分比比较来复制整行

Question

I'm trying to copy an entire row to another sheet if a cell is greater than 2% of another cell in the same row. This is what I'm stuck, getting an IF Greater based off a formula comparing 2 cells:

Sub Filtration()

For Each Cell In Sheets(1).Range("R:R")
    If Formula = "(R1 / P1)" > 0.021 Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets("Sheet2").Select
        ActiveSheet.Rows(matchRow).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Sheets("Sheet1").Select
    End If
Next

EDIT: Thanks to @JNevil & @ShaiRado and the help they provide, I think I'm only stuck on the Macro returning an Overflow. I think that the percentage = Cell.Value / Cell.Offset(, -2).Value is being confused/conflicted some how and believes that percentage = 0 always. There is also the issue that my Sheet1 contains blank lines, a header, and possible negative numbers on future updates. The full code is as follows:

Sub Filtration()

Dim writeRow As Integer
Dim percentage As Double

For Each Cell In Sheets(1).Range("R:R")

    'because we don't want to do this for every cell in Column R (There are one million), then exit the loop when we need to
    If Cell.Value = "" Or Cell.Value <= 0 Then

    'Lets make sure we won't be dividing by zero. If we are then set the result to 0
    If Cell.Offset(, -2).Value < 0 Then
        percentage = 0
    Else

        percentage = Cell.Value / Cell.Offset(, -2).Value

    End If

    'divide the current cell's value by the the cell one column over's value and compare
    If percentage > 0.021 Then

        'Write this out to the writeRow variable in the other sheet and increment that number by 1 after writing
        Sheet1.Rows(Cell.Row).Copy Destination:=Sheet2.Cells(writeRow, 1).Paste
        writeRow = writeRow + 1
    End If
    End If
Next
    End Sub

Answer 1

For having only been writing VBA for a week, you are doing a pretty good job here. Most people avoid For loops like the plague when they are learning.

A couple of things.

1. Avoid .select that is a user interface thing. VBA doesn't need to "Select" anything. You just point it at a range or a cell or a object and do what you need it to do.
2. Avoid activesheet and activeworkbook . When you are a couple hundred lines of code down don't risk assuming that you know what will be the active sheet or active workbook at that point in time. Don't trust it. Be explicit ThisWorkbook.Sheets("mysheetname") or similar.
3. Do the math in VBA. Don't call formula or whatever. VBA is good at it.

Something like the following should get you in the ballpark:

Sub Filtration()

    For Each Cell In Sheets(1).Range("R:R")
        'divide the current cell's value by the the cell one column over's value and compare
        If cell.value/cell.offset(,-2).value > .021 Then
            Sheet1.Rows(cell.row).Copy Destination:=Sheet2.Cells(cell.row, 1)           
            'because we don't want to do this for every cell in Column R (There are one million), then exit the loop when we need to
            If cell.value = "" Then Exit For
        End If
    Next

You may want to write to the other sheet without jumping rows. In that case you can employ a variable to track which row to write to:

Sub Filtration()
    Dim writeRow as integer

    For Each Cell In Sheets(1).Range("R:R")

        'because we don't want to do this for every cell in Column R (There are one million), then exit the loop when we need to
        If cell.value = "" Then Exit For

        'divide the current cell's value by the the cell one column over's value and compare
        If cell.value/cell.offset(,-2).value > .021 Then

            'Write this out to the writeRow variable in the other sheet and increment that number by 1 after writing
            Sheet1.Rows(cell.row).Copy Destination:=Sheet2.Cells(writeRow, 1)    
            writeRow = writeRow + 1             

        End If
    Next

Because dividing by zero will cause this code to fail, it may be a good idea to do your division before you check the result in the if statement. You can use a variable to capture the value for later comparison:

Sub Filtration()
    Dim writeRow as integer
    Dim percentage as double

    For Each Cell In Sheets(1).Range("R:R")

        'because we don't want to do this for every cell in Column R (There are one million), then exit the loop when we need to
        If cell.value = "" Then Exit For

        'Lets make sure we won't be dividing by zero. If we are then set the result to 0
        if cell.offset(,-2).value = 0 Then
            percentage = 0
        else
            percentage=cell.value/cell.offset(,-2).value
        end if

        'divide the current cell's value by the the cell one column over's value and compare
        If  percentage > .021 Then

            'Write this out to the writeRow variable in the other sheet and increment that number by 1 after writing
            Sheet1.Rows(cell.row).Copy Destination:=Sheet2.Cells(writeRow, 1)    
            writeRow = writeRow + 1             

        End If
    Next

Answer 2

Try the code below:

Sub Filtration()

Dim Cell As Range
With Sheets(1)
    For Each Cell In .Range("R1:R" & .Cells(.Rows.Count, "R").End(xlUp).Row)            
        If Cell.Value / Cell.Offset(, -2).Value > 0.021 Then
            .Rows(Cell.Row).Copy
             Sheets("Sheet2").Range("A" & Cell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                        SkipBlanks:=False, Transpose:=False               
        End If
    Next
End With

End Sub