How to get colors made by color scale of conditional formatting of Excel 2012 through VBA code

if no better answer is provided, you can try this workaround:

1. link / copy your data to cells under the chart (with formulas like =Sheet1!A1)
2. apply the same conditional formatting
3. hide the values (with custom number format like "", i.e. empty string literal (2 double quotes))
4. make the chart transparent
5. align the cells with the chart

---

UPDATE:

or you can try to compute the color by linear approximation for each R, G, B channel if the conditional format uses only 2 base colors (r1, g1, b1) and (r2, g2, b2) for 2 corner cases which can be

• min and max value, e.g.: 0 - 4 000
• min and max percent, e.g.: 10% - 90%
  (i believe you can use % * [max_value - min_value] to get the actual value)
• min and max percentile, e.g.: 0th percentile - 100th percentile

for percent / percentile options you first need to convert an actual value to the percent / percentile value, then if value < min or value > max use the corner colors, otherwise:

r = r1 + (r2 - r1) * (value - min_value) / (max_value - min_value)
g = ...
b = ...

This will copy a picture of a cell to the top-left corner of a chartobject on the same worksheet. Note the picture is linked to the copied cell - if the value or formatting color changes it will change to match.

Sub Tester()

    CopyLinkedPicToPlot ActiveSheet.Range("E4"), "Chart 2"

End Sub

Sub CopyLinkedPicToPlot(rngCopy As Range, chtName As String)

    Dim cht As ChartObject

    Set cht = ActiveSheet.ChartObjects(chtName)

    rngCopy.Copy
    With rngCopy.Parent.Pictures.Paste(Link:=True)
        .Top = cht.Top
        .Left = cht.Left
    End With

End Sub

EDIT: I just tested this with a fairly small 4x8 matrix of cells/charts and the performance is pretty bad! Might be better just pasting without Link:=True ...

This is not specific to your problem but is easily modified to solve your problem...

Sub CopyCondFill()
    Dim FromSheet As Object
    Dim ToSheet As Object
    Dim FromSheetName as String
    Dim ToSheetName as String
    Dim ToRange As Range
    Dim StrRange As String

    '''Sheet with formatting you want to copy
    FromSheetName = "YourSheetsName"
    Set FromSheet = Application.ThisWorkbook.Sheets(FromSheetName )
        '''Start of range within sheet you want to copy
        FromFirstRow = 3
        FromFirstCol = 2

    '''Sheet you want to copy formatting to
    ToSheetName = "YourSheetsName"
    Set ToSheet = Application.ThisWorkbook.Sheets(ToSheetName)
        '''range to copy formatting to
        ToFirstRow = 3
        ToFirstCol = 2
        '''NOTE: Adjust row/column to take lastrow/lastcol from or enter value manually
        ToLastRow = FromSheet.Cells(Rows.Count, 1).End(xlUp).Row
        ToLastCol = FromSheet.Cells(2, Columns.Count).End(xlToLeft).Column
        Set ToRange = ToSheet.Range(Cells(ToFirstRow, ToFirstCol), Cells(ToLastRow, ToLastCol))

        '''Apply formatting to range
        For Each cell In ToRange
            StrRange = cell.Address(0, 0)
            ToSheet.Range(StrRange).Offset(ToFirstRow - FromFirstRow, ToFirstCol - FromFirstCol).Interior.Color = _
                FromSheet.Range(StrRange).DisplayFormat.Interior.Color
        Next cell

End Sub