Alter code

[gav meredith]

hi ,

With a code provided for me recently, data pasted to a particular cell
range (sheet called VKnew) if its value was greater than 1. A new criteria
has been added and now i need to have the data paste to an alternate
location (on VKnew) if a cell in column C is red in colour AND the data in
columnD is greater than 1. Column C being red simply ditermines that the
data is of a different nature.

Simply, if column D is greater than 1, the
original below will remain......if column D is greater than 1 AND column C
is red, the data should paste under a different target name "optionals". How
on earth would i do this??

Original Code:

Private Sub CommandButton3_Click()
CopyData Range("D913"), "FEEDER"
CopyData Range("D1658"), "MACHINE"
CopyData Range("D6373"), "DELIVERY"
CopyData Range("D7882"), "PECOM"
CopyData Range("D8894"), "ROLLERS"
CopyData Range("D104128"), "MISCELLANEOUS"
Dim rng As Range, cell As Range
Dim nrow As Long, rw As Long
Dim Sh As Worksheet
Set rng = Range("D994")
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("D998")
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