Select cells based on colour, copy and paste as values

[stuartnoble54]

Hi Everyone,

I am creating P&L's that pull out numbers on OLE functions from my finance system. The end users of the P&L's do not have the permissions for this and values must be copied and pasted to hard code them.

I am looking for some code that will select multiple ranges of OLE cells, copy and paste as values.

I have been trying to do this by colouring the cells light grey (2) and picking them based on cell colour and found the following code to help identify this. I'm struggling to change this so it will copy and paste rather than display the ranges to me in a pop up - in honesty I don't understand it.
Sub YRange()
Dim c As Range, Yc As Range
For Each c In Range("A15:Z15")
If c.Interior.ColorIndex = 6 Then
If Yc Is Nothing Then
Set Yc = c
Else
Set Yc = Union(Yc, c)
End If
End If
Next c
If Not Yc Is Nothing Then MsgBox Yc.Address(False, False)
End Sub
Any suggestions welcome

Thanks in advance
Stuart

 

[Perpa]

- in honesty I don't understand it.
Sub YRange()
Dim c As Range, Yc As Range
For Each c In Range("A15:Z15")
If c.Interior.ColorIndex = 6 Then
If Yc Is Nothing Then
Set Yc = c
Else
Set Yc = Union(Yc, c)
End If
End If
Next c
If Not Yc Is Nothing Then MsgBox Yc.Address(False, False)
End Sub
Any suggestions welcome

Thanks in advance
Stuart

Stuart,
Welcome to the forum.
The code you provided does exactly what you described. The 'c' is a variable to identify each cell address being evaluated using the fill color ' c.Interior.ColorIndex = 6' to determine if the cell address should be accumulated in the ' Union(Yc, c)'. The macro checks ' Each c In Range("A15:Z15")' , ie.each cell in the range.

So something like the following should copy each cell with the ' c.Interior.ColorIndex = 6' to the corresponding cell on "yoursheetname". Don't forget to use the double quotes on each end of 'yoursheetname'. Change 'yoursheetname' to the name of the sheet where you will be copying the greyed cells to, ie. "Sheet2", or "mySheet", or whatever. I hope this is helpful.
Perpa

Sub CpyToNewSheet()
 Dim c As Range   ', Yc As Range
     For Each c In Range("A15:Z15")     'Just one row???
         If c.Interior.ColorIndex = 6 Then
             Sheets("yoursheetname").range(c).value = c.value
         End If
     Next c
Sheets("yoursheetname").activate
 
 End Sub