copy rows based on cell colour
 

Hi, can anybody please able to tell me the macro that how can i copy
rows to another sheet on based on cell colour. Like if i have
"Interior.Colorindex = 3" or Red in cell B1,B3 and B7 so how can i
copy those colored rows which should be not entire row but from Cell
A
to Cell F in length to any other sheet. Please anybody can help it
will be very helpful.... Thanks

copy rows based on cell colour
 

Try this:

Sub test()
a = 1
b = 1
For Each cell In Range("B1:B100")
Select Case cell.Interior.ColorIndex
Case Is = 3
Range(cell.Offset(, -1), cell.Resize(, 5)).Copy _
Sheets(2).Cells(a, 1)
a = a + 1
Case Is = 37
Range(cell.Offset(, -1), cell.Resize(, 5)).Copy _
Sheets(3).Cells(b, 1)
b = b + 1
End Select
Next cell
End Sub

--
Dan

On Dec 13, 4:05 pm, K wrote:
Hi, can anybody please able to tell me the macro that how can i copy
rows to another sheet on based on cell colour. Like if i have
"Interior.Colorindex = 3" or Red in cell B1,B3 and B7 so how can i
copy those colored rows which should be not entire row but from Cell
A
to Cell F in length to any other sheet. Please anybody can help it
will be very helpful.... Thanks

copy rows based on cell colour
 

Assumes the color is not set by format conditionsl

Sub cpyColr()
Dim c As Range
lastRw = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
For Each c In Worksheets(1).Range("B2:B" & lastRw)
If c.Interior.ColorIndex = 3 Then
lstRw2 = Worksheets(2).Range("A65536").End(xlUp).Row
cRng = c.Address
Worksheets(1).Range("A" & Range(cRng).Row & ":F" &
Range(cRng).Row).Copy _
Worksheets(2).Range("A" & lstRw2 + 1)
End If
Next
End Sub

If cells are colored by conditional format:

Sub cpyColr()
Dim c As Range
lastRw = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
For Each c In Worksheets(1).Range("B2:B" & lastRw)
If c.FormatConditions(1).Interior.ColorIndex = 3 Then
lstRw2 = Worksheets(2).Range("A65536").End(xlUp).Row
cRng = c.Address
Worksheets(1).Range("A" & Range(cRng).Row & ":F" &
Range(cRng).Row).Copy _
Worksheets(2).Range("A" & lstRw2 + 1)
End If
Next
End Sub

"K" wrote:

Hi, can anybody please able to tell me the macro that how can i copy
rows to another sheet on based on cell colour. Like if i have
"Interior.Colorindex = 3" or Red in cell B1,B3 and B7 so how can i
copy those colored rows which should be not entire row but from Cell
A
to Cell F in length to any other sheet. Please anybody can help it
will be very helpful.... Thanks

copy rows based on cell colour
 

I didn't get the line extension in the right place so after you paste the
code into your code module, make sure that all of this is on one line.

Worksheets(1).Range("A" & Range(cRng).Row & ":F" & _
Range(cRng).Row).Copy _
Worksheets(2).Range("A" & lstRw2 + 1)


"K" wrote:

Hi, can anybody please able to tell me the macro that how can i copy
rows to another sheet on based on cell colour. Like if i have
"Interior.Colorindex = 3" or Red in cell B1,B3 and B7 so how can i
copy those colored rows which should be not entire row but from Cell
A
to Cell F in length to any other sheet. Please anybody can help it
will be very helpful.... Thanks

copy rows based on cell colour
 

Sub cpyColr()
Dim c As Range
lastRw = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row
For Each c In Worksheets(1).Range("B2:B" & lastRw)
If c.FormatConditions.Count 0 Then
If c.FormatConditions(1).Interior.ColorIndex = 3 Then
lstRw2 = Worksheets(2).Range("A65536").End(xlUp).Row
cRng = c.Address
Worksheets(1).Range("A" & Range(cRng).Row & ":F" & _
Range(cRng).Row).Copy Worksheets(2).Range("A" & lstRw2 + 1)
End If
End If
Next
End Sub


"K" wrote:

Hi, can anybody please able to tell me the macro that how can i copy
rows to another sheet on based on cell colour. Like if i have
"Interior.Colorindex = 3" or Red in cell B1,B3 and B7 so how can i
copy those colored rows which should be not entire row but from Cell
A
to Cell F in length to any other sheet. Please anybody can help it
will be very helpful.... Thanks