Copy Fill Row to other Sheet

[aliikhlaq2006]

Pseudo Code
If any cell between (A1:D9) have color orange than
Select the row of that orange cell and copy to the other sheet first available empty row and put current date to right side of copy row

I have write some code but its not working

Sub copy_next_Row2()
If Sheet1.Range("D1:D9").Interior.Color = RGB(255, 192, 0) Then
Sheet1.Range("A1:D9").Copy
Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
Sheet2.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = Date
Else
MsgBox "There is no change"
End If


End Sub

 

[MARK858]

How are you coloring the cells normally or with conditional formatting? what version of Excel are you running?
Is

If any cell between (A1:D9) have color orange than

correct? or is it D1:D9 as you are sort of referencing in the If statement in the code?

 

[aliikhlaq2006]

How are you coloring the cells normally or with conditional formatting? what version of Excel are you running?
Is correct? or is it D1:D9 as you are sort of referencing in the If statement in the code?

Yes coloring is done from conditional formatting and yes D1:D9 is reference

 

[MARK858]

You didn't answer an important question (especially with your answer to the formatting) which was what version of Excel you are using, so assuming you are using Excel 2010 or later try...

Sub copy_next_Row2()
    Dim mycell As Range
    For Each mycell In Sheet1.Range("D1:D9")
        If mycell.DisplayFormat.Interior.Color = RGB(255, 192, 0) Then
            Range(Cells(mycell.Row, "A"), Cells(mycell.Row, "D")).Copy
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Sheet2.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = Date
        End If
    Next
    Application.CutCopyMode = False
End Sub

 

[MARK858]

Actually a bit lazy (and incorrect) with the previous code so try the code below...

Sub copy_next_Row2()
    Dim mycell As Range, i As Long
    Application.ScreenUpdating = False
    i = 0
    For Each mycell In Sheet1.Range("D1:D9")
        If mycell.DisplayFormat.Interior.Color = RGB(255, 192, 0) Then
            Sheet1.Range(Sheet1.Cells(mycell.Row, "A"), Sheet1.Cells(mycell.Row, "D")).Copy
            Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Sheet2.Range("E" & Rows.Count).End(xlUp).Offset(1, 0).Value = Date
            i = i + 1
        End If
    Next
    If i = 0 Then MsgBox "There is no change"
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

 

[aliikhlaq2006]

Thank you this code work for me