Copy and Paste Row Dependent On Cell Colour

[hobbiton73]

Hi, I wonder whether someone may be able to help me please.


I've been trying to find a solution to this all day without any success, so it's left me a little perplexed.


I'm using a spreadsheet called 'Resource Summary 12-13'. This sheet profiles staff resource across the year, and by conditionally formatting the cells, areas which have spare capacity are highlighted via cell fill colour 10.


What I'm trying to do is:


Check that there is a value in column A starting from row 5, if there is,

Look at the cells on these rows in columns 'D', 'F', 'H', 'J', 'L', 'N', 'P', 'R', 'T', 'V', 'X' and 'Z' and if there is a cell with fill colour of index number 10, then


Copy that row from columns 'A', 'D', 'F', 'H', 'J', 'L', 'N', 'P', 'R', 'T', 'V', 'X' and 'Z', and then


Paste this data into another sheet called 'Forecasts' into the columns 'A', 'C', 'E', 'G', 'I', 'K', 'M', 'O', 'Q', 'S', 'U', 'W' and Y.


I really just wondered whether someone could possibly take a look at this please and offer some guidance on how I may go about this.


Many thanks and kind regards

 

[Luke M]

Before digging too deep, I noticed that you first mentioned that the cells are conditionally formatted, but later you talk about color index. Note that conditional formatting color is different than regular format, and is harder to detect. It would be much easier to detect the same condition that the CF is using (ie, value is > 10) and go off of that.

Here's a basic outline. Note that this is just the structure, the condition part still needs to be written.

[pre]

Sub ColorCheck()
Dim LastRow As Long
Const MyColor = 10
Dim i As Long
Dim RecordCound As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp)
End With

'First row to paste data to
RecordCount = 1

Application.ScreenUpdating = False

For i = 5 To LastRow
If Cells(i, "A").Value <> "" Then
'========
'Being psuedocode
For Each cell In Range("Range that I specify")
If conditionIsMet Then
With Worksheets("Forecasts")
Cell1.Copy .Cells(RecordCount, SpecificColumn)
Cell2.Copy .Cells(RecordCount, SpecificColumn)
Cell3.Copy .Cells(RecordCount, SpecificColumn)
'...etc
End With
RecordCount = RecordCount + 1
Exit For
End If
Next cell
'End pseudocode
'========
End If
Next i

Application.ScreenUpdating = True

End Sub

[/pre]