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

时间:2018-03-23 03:47:14

标签: excel vba excel-vba

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

我在下面提供了一些图片来帮助解释我希望实现的目标:

工作表1 - 3月18日:
Worksheet 1 - Mar 18

工作表7 - 网站1:
Worksheet 7 - Site 1

查看工作表1 - 3月18日,我想将单元格颜色从第3行(B3到X3)复制到工作表7 - 站点1列B(B3到B23)。我还有额外的工作表,4月18日到12月18日,以及2号站点到站点6,我想执行类似的操作。

最终结果会将月份工作表中的信息汇总到网站工作表中。

3 个答案:

答案 0 :(得分:0)

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

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

答案 1 :(得分:0)

你可以试试这个

Sub CopyColors

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

 End Sub

并扩展到您的需求

答案 2 :(得分:0)

试试这段代码:

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