Transfer the colorindex of a cell to another, without using paste or pastespecial

  • Thread starter Thread starter Thulasiram
  • Start date Start date
T

Thulasiram

Hello people,

I would like to transfer the format of the cells (value and colorindex)
"without" using pastespecial or paste command. I have written a code
like this

Sub test()
Sheet2.Range("A1:A15").Value = Sheet1.Range("A1:A15").Value
Sheet2.Range("A1:A15").Interior.ColorIndex =
Sheet1.Range("A1:A15").Interior.ColorIndex
End Sub

Values are transferred but not the colorindex. How could the coloindex
of the cells be transferred without using the pastespecial command?

Please provide your help..

Thanks,
Thulasiram
 
If all the cell have the same .colorIndex, you code will work. However, I
suspect this is not the case, hence the failure. So,

Dim Cell As Range

For Each Cell In Sheet1.Range("A1:A15")
Sheet2.Range(Cell.Address).Interior.ColorIndex =
Cell.Interior.ColorIndex
Next

NickHK
 
i have something similar for a client. they use box codes and are listed in
u1:u8.
this code determines the cell colors and then formats the cells in u24:u357
accordingly. maybe it will give you an idea.

Set rng = ws.Range("U24:U357")

With rng
For Each cell In rng
Select Case cell.Value
Case "10R"
fClr = ws.Range("U1").Font.ColorIndex ' 2 'white
bClr = ws.Range("U1").Interior.ColorIndex ' 9 ' brown
Case "BAB"
fClr = ws.Range("U2").Font.ColorIndex ' 2 ' white
bClr = ws.Range("U2").Interior.ColorIndex ' 1 ' black
Case "BDM"
fClr = ws.Range("U3").Font.ColorIndex ' 1 'black
bClr = ws.Range("U3").Interior.ColorIndex ' 2 'white
Case "G-2"
fClr = ws.Range("U4").Font.ColorIndex ' 1 'black
bClr = ws.Range("U4").Interior.ColorIndex ' 3 'red
Case "Per-2"
fClr = ws.Range("U5").Font.ColorIndex ' 1 'black
bClr = ws.Range("U5").Interior.ColorIndex ' 48 'gray
Case "RT24"
fClr = ws.Range("U6").Font.ColorIndex ' 1 'black
bClr = ws.Range("U6").Interior.ColorIndex ' 39 'violet
Case "W-2" ' change color codes below
fClr = ws.Range("U7").Font.ColorIndex ' 2 'white
bClr = ws.Range("U7").Interior.ColorIndex ' 11 'dk blue
Case "X-2"
fClr = ws.Range("U8").Font.ColorIndex ' 1 'black
bClr = ws.Range("U8").Interior.ColorIndex ' 43 'green
End Select
cell.Interior.ColorIndex = bClr
cell.Font.ColorIndex = fClr
Debug.Print bClr & " " & fClr
Next
End With
 
Fantastic Nick! Infact, I was tweaking something with For loop.. I
ended up facing errors. But, your code works perfect.. Nice usage of
the for loop for the question that I posted...
 
Gary,

Thanks for ur initiative to help... I had a look at your code. It gave
an idea.. Nick's code solved the issue..
 
Nick,

In the code below, I am trying to shift the values, a cell before in
the other sheet. Cell value is transferredas expected but not the
colorindex.

Is there any command like (cell.address-1).. Please help.

Sheet2.Range("B1:I1").Value = Sheet1.Range("C1:J1").Value
For Each cell In Sheet1.Range("C1:J1")
Sheet2.Range(cell.Address).Interior.ColorIndex =
cell.Interior.ColorIndex
Next

Thanks,
Thulasiram
 
Nick,

In the code below, I am trying to shift the values, a cell before in
the other sheet. Cell value is transferred as expected but not the
colorindex.

Is there any command like (cell.address-1).. Please help.

Sheet2.Range("B1:I1").Value = Sheet1.Range("C1:J1").Value
For Each cell In Sheet1.Range("C1:J1")
Sheet2.Range(cell.Address).Interior.ColorIndex =
cell.Interior.ColorIndex
Next

Thanks,
Thulasiram
 
look at the offset function


Sub test()

With Worksheets("Sheet1")
For Each cell In .Range("C1:J1")
Debug.Print cell.Address
Worksheets("Sheet2").Range(cell.Address).Offset(0, -1).Interior.ColorIndex =
3
Next
End With
End Sub
 
Add an .Offset. e.g.

Sheet2.Range(cell.Address).Offset(0,-1).Interior.ColorIndex =
cell.Interior.ColorIndex

NickHK
 
Back
Top