How do I transfer color formats from one work sheet to another

[Guest]

SheetA contain a number of cells formatted in red and a number in blue (most
are black). I wish to transfer this color format to SheetB, but offsetting
the cells by two columns. Thus if cell A3 is red in SheetA, I want cell
C3 to be red in SheetB, and if it is blue I want the color in SheetB to be
blue. And I want this for the whole spreadsheet.

Any help with a macro?

Thanks

 

[E Oveson]

You could select the region from which you want to transfer and then click
on the "Format Painter" button on the standard toolbar. Then on the second
sheet, select the column offset 2 from original and it should paste all of
those formats. (Or use Copy and then Paste Special | Formats). If you
wanted the macro for that you could just record that operation.

-Erik

 

[Guest]

You could select the region from which you want to transfer and then click
on the "Format Painter" button on the standard toolbar. Then on the second
sheet, select the column offset 2 from original and it should paste all of
those formats. (Or use Copy and then Paste Special | Formats). If you
wanted the macro for that you could just record that operation.

-Erik

Thanks Erik, but I just want to PasteSpecial the cell color, not its width
or its border formats.

 

[Guest]

Solved my own problem! (Always the best way?) This sub is a bit crude as I
assume I will have no more than 100 rows, and only want to transfer color
format (and no other cell format details) from Row B in SheetA to Row F in
SheetB

Sub CopyColor()
'
' Copycolor Macro
' Macro recorded 16/11/2004 by Kanga85
'
' Keyboard Shortcut: Ctrl+c
'
Dim ICI(100) As Integer
Dim FCI(100) As Integer
Dim i As Integer
Sheets("SheetA").Select
Range("B1").Select
For i = 1 To 100
ICI(i) = ActiveCell.Interior.ColorIndex
FCI(i) = ActiveCell.Font.ColorIndex
ActiveCell.Offset(1, 0).Select
Next i
Sheets("SheetB").Select
Range("F1").Select
For i = 1 To 100
ActiveCell.Interior.ColorIndex = ICI(i)
ActiveCell.Font.ColorIndex = FCI(i)
ActiveCell.Offset(1, 0).Select
Next i
End Sub