将多个单元格颜色从一个工作表复制到另一个工作表

Question

在构建VBA代码方面，我是个新手。我想自动将单元格颜色从一个工作表复制到另一个工作表。

以下我提供了一些图片，以帮助解释我希望实现的目标：

工作表1至3月18日：

​

工作表7-工地1：

​

查看工作表1-Mar18，我想将单元格颜色从第3行(B3到X3)复制到工作表7-站点1列B (B3到B23)。我也有额外的工作表，4月18日至12月18日和第2站点到第6站点，在那里我想执行类似的行动。

最终结果将把月工作表中的信息汇总到站点工作表中。

Answer 1

下面是一个简单的例程，它演示了如何根据第二个工作表中单元格的颜色对一个工作表上的单元格进行着色。在彻底了解了这段代码的工作原理之后，您应该能够修改它以应用于您的情况。如果你有问题请告诉我。

Sub colorCells()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim r1 As Range, r2 As Range, numToColor As Integer, i As Integer
Set sh1 = Worksheets("1")
Set sh2 = Worksheets("2")
Set r1 = sh1.Range("B3")
Set r2 = sh2.Range("B3")
numToColor = 10
For i = 1 To numToColor
  r2.Offset(0, i).Interior.Color = r1.Offset(0, i).Interior.Color
Next i
End Sub

Answer 2

你可以试试这个

Sub CopyColors

    Worksheets("Mar 18").Range("B3:X3").Copy
    Worksheets("site 1").Range("B3").PasteSpecial Transpose:=True

 End Sub

并扩展到你的需要

Answer 3

试试下面的代码：

Sub CopyColor()
Dim i As Long: i = 1
Dim cell As Range
'loop through all cells in specified range in specified worksheet
For Each cell In Worksheets("Mar 18").Range("B3:X3")
    ' copy color and paste it to another cells in worksheet Site 1
    Worksheets("Site 1").Cells(i, 2).Interior.Color = cell.Interior.Color
    i = i + 1
Next
End Sub