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
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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.