transfer selected data by colour and move to another sheet

[Patriot2879]

Hi, good morning. Hope you are all well? please can you help me I have the code below where I am trying to transfer data from sheet1 to sheet2, but it has to be data that ihas coloured rows in red and green for example, and then to transfer the whole row from A - V. then to shift cells up and remove the blanks, I have tried code below but getting errors, hope you can help?

Sub copy_paste_based_on_cell_interior_rgb()
    Const blue As String = "R:0 G:128 B:0"
    Const purple As String = "R:255 G:0 B:0"
    Dim i As Long
    
    With Worksheets("Sheet1")
        For i = 4 To .Range("A5" & .Rows.Count).End(xlUp).Row
            Select Case rgb_valz(.Range("A" & i))
                Case blue, purple
                    .Range("A" & i & ":V" & i).Copy Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .Range("A" & i).Interior.Color = RGB(255, 0, 255)
            End Select
        Next i
    End With
End Sub

Public Function rgb_valz(rng As Range) As String
    rgb_valz = _
        "R:" & rng.Interior.Color Mod 256 & _
        " G:" & (rng.Interior.Color Mod 256 ^ 2) \ 256 & _
        " B:" & rng.Interior.Color \ 256 ^ 2
End Function

 

[Fluff]

Try

For i = 4 To .Range("A" & .Rows.Count).End(xlUp).Row

 

[Patriot2879]

that's worked great, thank you, how do I remove the data transferred from sheet1? and move empty cells up in sheet1? thank you again for the help

 

[Fluff]

Just delete the entire row.

 

[Patriot2879]

Hi thanks for the reply back, is there no way to do it in code at all please? hope you can advise?

 

[Fluff]

You do it like

   With Worksheets("Sheet1")
      For i = .Range("A5" & .Rows.Count).End(xlUp).Row To 4 Step -1
      Select Case rgb_valz(.Range("A" & i))
         Case blue, purple
            .Range("A" & i & ":V" & i).Copy Worksheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Rows(i).Delete
         End Select
      Next i
   End With

Note that when deleting rows you need to loop from bottom up.

 

[Patriot2879]

thank you that's great your knowledge and help is much appreciated

 

[Fluff]

You're welcome & thanks for the feedback