copy cells from one sheet to another when criteria is met.

Re: copy cells from one sheet to another when criteria is met.

Would be easier with a sample sheet, and I'm ASSUMING you meant "copy the whole ROW".

Further assuming % is in column 8, main sheet is Sheet1, other sheet is Sheet2 and there may already be data on the second sheet:

Sub sample2()
Dim rdata As Range
Dim c As Range
Set rdata = Range(Sheet1.Cells(2, 8), Sheet1.Cells(65000, 8).End(xlUp))
For Each c In rdata.Cells
    If c.Value > 1 Then
        Sheet2.Cells(65000, 8).End(xlUp).Offset(1, 0).EntireRow.Value = c.EntireRow.Value
    End If
Next
End Sub

Re: copy cells from one sheet to another when criteria is met.

Hi

Moving data in batches is a nice way to shift the data. However you did not say if you wanted to overwrite the data on the other sheet or add to it. I chose the latter.

Sub MoveData()
  Range("H1:H" & Cells(Rows.Count, 8).End(xlUp).Row).AutoFilter 1, ">1"
  Range("A2:H" & Cells(Rows.Count, 8).End(xlUp).Row).Copy Sheet2.Range("A" & Rows.Count).End(xlUp)(2)
End Sub

Might be an idea to add a test for no values being above 100%.

Take care

Smallman

Re: copy cells from one sheet to another when criteria is met.

MUCH prefer Smallman's solution, but should really turn the filter off again when done

Range("H1:H" & Cells(Rows.Count, 8).End(xlUp).Row).AutoFilter

and be aware this won't work unless sheet1 is the active sheet