Merge Format from 2 excel sheets

[gameover]

Hi All,

I have 2 excel sheets which are totally same in terms of Rows/Columns or cell values. The only difference is cell color.

e.g. My 1st workbook has 10 rows and 10 columns. In this workbook cell R1C1, R1C3 , R2C2, R2C5 are red in color.

My second workbook is same as 1st workbook but in this workbook cell R1C1, R1C2, R2C3, R2C5 are red in color.

What I need is to merge these 2 workbooks and my final workbook should have cells R1C1, R1C3 , R2C2, R2C5, R1C2, R2C3 red in color.

Any help is greatly appreciated. Thanks for your time and answer in advance.

Please let me know if I am not clear.

Thanks

 

[gameover]

Hi All,

I have 2 excel sheets which are totally same in terms of Rows/Columns or cell values. The only difference is cell color.

e.g. My 1st workbook has 10 rows and 10 columns. In this workbook cell R1C1, R1C3 , R2C2, R2C5 are red in color.

My second workbook is same as 1st workbook but in this workbook cell R1C1, R1C2, R2C3, R2C5 are red in color.

What I need is to merge these 2 workbooks and my final workbook should have cells R1C1, R1C3 , R2C2, R2C5, R1C2, R2C3 red in color.

Any help is greatly appreciated. Thanks for your time and answer in advance.

Please let me know if I am not clear.

Thanks

Never Mind. My problem is solved by this macro:

Sub CopyColor()
Dim SourceSht As Worksheet
Dim TargetSht As Worksheet
Dim rngCopy As Range
Dim rngPaste As Range
Dim LastCopyRow As Long
Dim LastCopyColumn As Long


'Define what our source sheet and target sheet are
Set SourceSht = ThisWorkbook.Worksheets("DEO")
Set TargetSht = ThisWorkbook.Worksheets("QC")


'Find our used space on the source sheet
LastCopyRow = SourceSht.Cells(Rows.Count, "A").End(xlUp).Row
LastCopyColumn = SourceSht.Cells(1, Columns.Count).End(xlToLeft).Column


'Setup our ranges so we can be sure we don't loop through unused space
Set rngCopy = SourceSht.Range("A1:" & SourceSht.Cells(LastCopyRow, LastCopyColumn).Address)
Set rngPaste = TargetSht.Range("A1:" & TargetSht.Cells(LastCopyRow, LastCopyColumn).Address)


'Loop through each row of each column.
' This will go through each cell in column 1, then move on to column 2
For Col = 1 To LastCopyColumn
    For cel = 1 To LastCopyRow
        ' If the string value of our current cell is not empty.
        If rngCopy.Cells(cel, Col).Interior.ColorIndex = 3 Then
            'Copy the source cell displayed color and paste it in the target cell
            rngPaste.Cells(cel, Col).Interior.Color = rngCopy.Cells(cel, Col).DisplayFormat.Interior.Color
        End If
    Next cel
Next Col
End Sub

Thanks for your time.