How to copy all cell colors from one workbook to another in Excel VBA?

Question

I have two large workbooks with identical sheet names, and similar data. The source sheet has a bunch of colors applied to the cells, and I have to copy those colors to their respective cells in the destination sheet.

I've tried this suggestion: How to copy an Excel color scheme from one workbook to another

But it didn't seem to do anything.

This is the code I wrote, but it locks up excel for a long time. Does it look right to you?

Sub CopyColors()

Dim x As Workbook
Dim y As Workbook
Dim SomeSheet As Worksheet
Dim SomeRange As Range

Set x = Workbooks.Open(" c:/PATH/Source.xlsm ")
Set y = Workbooks.Open(" c:/PATH/Destination.xlsm ")

y.Colors = x.Colors

For Each SomeSheet In x.Worksheets
    For Each SomeRange In SomeSheet.Cells
        y.Sheets(SomeSheet.Name).Range(SomeRange.Address).Interior.ColorIndex = SomeRange.Interior.ColorIndex
    Next SomeRange
Next SomeSheet

End Sub

I decided it'd be a better use of my time to explore other options than to wait for this to pan out. If I don't get a better idea, I'll let this run overnight tonight.

Answer 1

You may be able to adapt this to sheets in different workbooks. Say we have two sheet in the same workbook. We want to copy the colors. Rather than looping of all the cells individually, we copy all the cells from the first sheet and and PasteSpecialFormats into the second worksheet:

From the Recorder:

Sub Macro2()
    Sheets("Sheet1").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Sheet2").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
End Sub