Value change with date

[bobby_793]

Helloo

Is there any way that if in one coloum i have more than 2500 numbers and i have put the conditional values that if the value is grater than 500 the cell color should be red. this farmula works fine. Now the matter is red color cell should copy to the next sheet with complete row data.

Is there any way in VBA

Thanks

Bobby

[georgiboy]

This should do it it you adjust it to your ranges and sheet names
[VBA]Sub MoveRow()
Sheets("Sheet1").Range("A1").Activate
Do While ActiveCell.Value <> ""
If ActiveCell.Value > 500 Then
ActiveCell.EntireRow.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Sheet2").Select
Range("A1").Select
Do While ActiveCell.Value <> ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.PasteSpecial xlPasteValuesAndNumberFormats
Sheets("Sheet1").Activate
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop

End Sub[/VBA]

Hope this helps

[bobby_793]

Thank you georgiboy really its work fine
thank you

[mdmackillop]

Hi Georgi,
While the loop works, it can be slow for a lot of data. You can speed it up be avoiding selecting as
[VBA]
Option Explicit
Sub MoveRow()
Dim Tgt As Range, cel As Range
Dim i As Long

Application.ScreenUpdating = False

Set Tgt = Sheets(2).Cells(Rows.Count, 1).End(xlUp)
With Sheets(1)
For Each cel In Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
If cel > 500 Then
i = i + 1
cel.EntireRow.Copy
Tgt.Offset(i).PasteSpecial xlAll
End If
Next
End With
Application.ScreenUpdating = True

End Sub
[/VBA]

Better still, apply a filter for this sort of procedure. Very much quicker.
[VBA]
Option Explicit
Sub FilterData()
With Sheets(1)
.Columns("A:A").AutoFilter Field:=1, Criteria1:=">500"
.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Sheets(3).Range("A1").PasteSpecial xlAll
.Columns("A:A").AutoFilter
End With
End Sub

[/VBA]