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

Question

我正在尝试在一个工​​作表上复制一系列单元格，然后根据colorindex将颜色粘贴到另一工作表上。

我要在工作表1上复制单元格

且仅将colorindex = 49的单元格粘贴到sheet2上

这是我尝试做的事情： 是否有比编写90个If语句更好或更快速的方法？

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

尝试此功能

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

然后您可以在if语句中使用它。如果getfillcolor（cell）= 49，请执行以下操作

Answer 2

您可以使用此代码段将内部颜色复制到第二张纸上。如果要指定另一个已经存在的“第二”工作表，则可以这样输入工作表名称，而不是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