can you please explain how to integrate this with my existing code??

"Cecilkumara Fernando" <cekufdo@sltnetDOTlk wrote in message
...
gav meredith,
Try this
Sub Checker()
Dim cell As Range
Dim col As String
For Each cell In Range("D9:D98")
If Cells(cell.row, "C").Interior.ColorIndex = 3 Then
col = "G"
Else
col = "F"
End If
If Not IsEmpty(cell) Then
If IsNumeric(cell.Value) And _
cell.Value 1 Then
Cells(cell.row, col).Value = cell.Value
End If
End If
Next
End Sub

HTH
Cecil

"gav meredith" wrote in message
...
Hi,

Within the following code, can someone please show me how to implement
this.....

Sub Checker()
Dim cell as range
For Each cell In Range("D9:D98")
If Not IsEmpty(cell) Then
If IsNumeric(cell.Value) Then
If cell(cell.row, "C").Interior.ColorIndex = 3 _
And _
cell.Value 1 Then
cells(cell.Row,"G").Value = Cell.Value
End If
End If
End If
Nexr

End Sub

This is the existing code that copies and pastes based on a cell value
greater than 1. What the above is supposed to accomplish is the same BUT
a
red cell in columnC would paste to an alternate location. Thanks so
much!!!!

Private Sub CommandButton3_Click()
CopyData Range("D9:D13"), "FEEDER"
CopyData Range("D16:D58"), "MACHINE"
CopyData Range("D63:D73"), "DELIVERY"
CopyData Range("D78:D82"), "PECOM"
CopyData Range("D88:D94"), "ROLLERS"
CopyData Range("D104:D128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D9:D94")
nrow = Application.CountIf(rng, "0")
Set Sh = Worksheets("VK new")
Debug.Print Sh.Range("A10").Resize(nrow * 1,
1).EntireRow.Address(external:=True)
' sh.Range("A10").Resize(nrow * 1).EntireRow.Insert
rw = 10
For Each cell In Range("D9:D98")
If Not IsEmpty(cell) Then
If IsNumeric(cell) Then
If cell 0 Then
Cells(cell.Row, 1).Copy
Sh.Cells(rw, "A").PasteSpecial
Paste:=xlPasteValues
Cells(cell.Row, 4).Copy
Sh.Cells(rw, "F").PasteSpecial
Paste:=xlPasteValues
rw = rw + 1
End If
End If
End If
Next
End Sub