根据单元格colorindex从一个工作表的粘贴范围复制范围到另一工作表的另一工作表

Question

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

and only paste cells with colorindex = 49 on sheet2

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

Answer 1

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

Answer 2

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