Copy multiple cell colours from one worksheet to a

2019-08-30 00:42发布

I am a novice when it comes to building VBA code. I want to automatically copy cell colours from one worksheet to another.

I have provided some images below to help explain what I am hoping to achieve:

Worksheet 1 - Mar 18:
Worksheet 1 - Mar 18

Worksheet 7 - Site 1:
Worksheet 7 - Site 1

Looking at Worksheet 1 - Mar 18, I want to copy the cell colours from row 3 (B3 to X3) to Worksheet 7 - site 1 Column B (B3 to B23). I also have additional worksheets, Apr 18 to Dec 18 and Site 2 to Site 6 where I would like to perform similar actions.

The end result will roll up the information from the month worksheets into the site worksheets.

3条回答
smile是对你的礼貌
2楼-- · 2019-08-30 01:20

Here's a simple routine that demonstrates how cells on one sheet can be colored based on the color of cells in a second sheet. After you thoroughly understand how this code works, you should be able to modify it to apply to your situation. Let me know if you have questions.

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
查看更多
beautiful°
3楼-- · 2019-08-30 01:30

You can try this

Sub CopyColors

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

 End Sub

And extend to your needs

查看更多
我命由我不由天
4楼-- · 2019-08-30 01:35

Try this code:

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
查看更多
登录 后发表回答