Copy on condition and paste to last+2 row

I

infojmac

Hi

Hope someone can help,

In the column A i have data starting at A4 which could end at any row


What i want to happen is if the data font is blue it copys the valu
and pastes it two cells down from the last cell with a value. There ma
be more than one value which is in blue font so then it should copy an
paste to the last cell + 3 etc.

I also wanted to add some predefined text when it copied it in the sam
cell. E.g. "This 'value' does not meet our criteria"

I would be grateful if anyone could also give a brief explanation o
their solution.

Thank
 
T

Tom Ogilvy

Dim rng as Range, cell as Range
Dim rw as Long
set rng = Range(Cells(4,1),Cells(rows.count,1).end(xlup))
rw = rng(rng.rows.count)(3).row
for each cell in rng
if cell.font.colorIndex = 5 then
cell.copy destination:=cells(rw,1)
rw = rw + 1
end if
Next

if the font color is produced by conditional formatting, then you can't
check the font color directly. You would need to check the same conditions
as conditional formatting is checking.
 
C

Charles

info,

This is what I came up with. There will be other ways.


Charles

Sub move_text()
Dim rng As Range, finalrow As Range
Dim i As Integer
Dim firstloop As Boolean
firstloop = True
Set rng = Worksheets("sheet1").Cells(4, 1).CurrentRegion
Set finalrow = Range("A65536").End(xlUp)
For i = 1 To rng.Rows.Count
If rng(i, 1).Font.ColorIndex = 5 Then
If firstloop = True Then
finalrow.Offset(2, 0) = rng(i, 1).Value & " This is
test"
firstloop = False
Else
Set finalrow = Range("A65536").End(xlUp)
finalrow.Offset(1, 0) = rng(i, 1).Value & " This is a t"
End If
End If
Next
End Su
 
Top