Copy multiple cell colours from one worksheet to another

问题

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 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.

回答1:

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

回答2:

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

回答3:

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

来源：https://stackoverflow.com/questions/49442039/copy-multiple-cell-colours-from-one-worksheet-to-another