Copy Range From One Sheet Paste Part of Range In another Sheet Based On Cell colorindex

0
votes

I am trying to copy a range of cells on one worksheet and paste the color on another worksheet based on the colorindex.

I want to copy cells on sheet1

img1

and only paste cells with colorindex = 49 on sheet2

img2

This is what I've tried doing: Is there a better or faster way of doing this than writing 90 If statements?

Private Sub CommandButton3_Click()

If Range("A1").Interior.ColorIndex = 49 Then
Worksheets("Sheet2").Range("A1").Interior.ColorIndex = 49
Else: Range("A1").Interior.ColorIndex = -4142
End If

If Range("A2").Interior.ColorIndex = 49 Then
Worksheets("Sheet2").Range("A2").Interior.ColorIndex = 49
Else: Range("A2").Interior.ColorIndex = -4142
End If

If Range("A3").Interior.ColorIndex = 49 Then
Worksheets("Sheet2").Range("A3").Interior.ColorIndex = 49
Else: Range("A3").Interior.ColorIndex = -4142
End If

If Range("A4").Interior.ColorIndex = 49 Then
Worksheets("Sheet2").Range("A4").Interior.ColorIndex = 49
Else: Range("A4").Interior.ColorIndex = -4142
End If

If Range("A5").Interior.ColorIndex = 49 Then
Worksheets("Sheet2").Range("A5").Interior.ColorIndex = 49
Else: Range("A5").Interior.ColorIndex = -4142
End If

End Sub
2
excelvbarangebackground-colorcopy-paste
Show us what you have tried, and where you have run into problems. This is not a free code-writing service, but we can help you with complex formulas or code you are trying to develop. To develop a good question that can allow us to help you, it might be helpful to read the HELP topics for How do I Ask a Good Question, and also How to create a Minimal, Complete, and Verifiable example. Then edit your question (or post a new one). – Ron Rosenfeld

2 Answers

0
votes

Try this function

Function GetFillColor(Rng As Range) As Long
      GetFillColor = Rng.Interior.ColorIndex
End Function

Then you can use it in an if statement. If getfillcolor(cell) = 49 then do something

0
votes

You can use this snippet to copy the interior color over to the second sheet. If you want to specify another 'second' sheet that already exists you can put the sheet name like this instead Sheets("Sheet Name").Interior ....

If sheets.count < 2 Then sheets.Add after:=sheets(1)

Dim theCell As Range
For Each theCell In sheets(1).Range("A1:E16")
    With theCell
        If .Interior.ColorIndex = 49 Then
            sheets(2).Cells(.row, .Column).Interior.ColorIndex = 49
        Else
            sheets(2).Cells(.row, .Column).Interior.ColorIndex = -4142
        End If
    End With
Next theCell