Search code examples
excelvbacopy-paste

Paste Results from Find Greater Than in Next Cell Down


I am automating a Workbook my team complete each month and have become stuck with a code for returning results on Find Greater Than.

I did not write this code originally, I found it on Stackoverflow and adapted for my purpose. Original code is from: excel vba copy cells to another sheet if cell value is greater than 0

On my sheet "Agent Count" I have information in Columns A, B, C, with C containing a numerical count result. The code finds any count greater than 50. When the code finds a count greater than 50 in Column C, it then copy and pastes the three cells to a new location on the same sheet, starting at "F2". Creating a separate summary table of counts greater than 50.

The code is successfully finding and copying and pasting counts greater than 50. However after pasting the result it is not moving down to the next row. So pastes the next result over the top of the previous result.

How to write the code so the paste moves down through the rows F2, F3, F4 etc for each result?

Sub FindGreaterThan50V3()
    
    Dim range1 As Range
    Dim cell As Range
    Set range1 = Sheets("Agent Count").Range("c:c")
    
    For Each cell In range1
        If cell.Value > 50 Then
            With Sheets("Agent Count")
                .Range(.Cells(cell.Row, "a"), .Cells(cell.Row, "c")).Copy _
                   Sheets("agent count").Range("f2").End(xlUp).Offset(1, 0)
            End With
        End If
    Next cell
    
    
End Sub

Solution

  • This:

     .Range(.Cells(cell.Row, "a"), .Cells(cell.Row, "c")).Copy _
           Sheets("agent count").Range("f2").End(xlUp).Offset(1, 0)
    

    Should probably be:

     .Range(.Cells(cell.Row, "a"), .Cells(cell.Row, "c")).Copy _
            Sheets("agent count").Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
    

    Couple more suggestions:

    Sub FindGreaterThan50V3()
        
        Dim range1 As Range, ws As WorkSheet
        Dim cell As Range
    
        Set ws = ThisWorkbook.Sheets("Agent Count")
        'no need to scan the whole column
        Set range1 = ws.Range("C1:C" & ws.cells(ws.Rows.Count, "C").End(xlUp).Row)
        
        For Each cell In range1.Cells
            If cell.Value > 50 Then
                cell.Resize(1, 3).Copy _
                   ws.Cells(ws.Rows.Count, "F").End(xlUp).Offset(1, 0)
            End If
        Next cell
    End Sub