根據單元格colorindex從一個工作表的粘貼范圍復制范圍到另一工作表的另一工作表

Question

我正在嘗試在一個工​​作表上復制一系列單元格，然后根據colorindex將顏色粘貼到另一工作表上。

我想復制sheet1上的單元格

並且僅將sheet2上的colorindex = 49的單元格粘貼

這就是我嘗試做的事情：是否有比編寫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