Copy the EFFECTS of a Condition Formatting rule

[julhs]

When using VBA to copying a cell, I want to retain the EFFECT of a CF rule on that cell as well.(NOT the rule itself)

For example;
Cell S10 has CF rule that changes the cell colour if the value in Q10 equates True,
S10 CF rule is (=Q10="Me", with green fill colour), so when Q10 = “ME”, S10 has green fill colour.

Problem I’m trying to get over is; I’m ONLY copying/pasting S10 (not Q10 as well) so the S10 CF has lost its reference cell (Q10), resulting in the copied cells NOT having a fill colour.

What I’m trying to do is; add to my existing code the ability to return S10’s green fill colour (the RESULT of the CF) when S10 is copied/pasted to a new location.
I’ve tried numerous things found on line but not had any joy so far in converting them.

This is my currant actual code; it essentially finds cells in Col S that have “Comments” in & copies them with values of another Col on the same row to another location:

Sub juhls4_plus2()

Dim lRow As Long, DestRow As Long, i As Integer
Dim rng As Range
Dim sht As Worksheet
Dim lrw As Long
Dim fRow As Long

  Set sht = ThisWorkbook.ActiveSheet
                        Application.ScreenUpdating = False
                'To clear the Destination range before new paste
               ' first finds the row beneath target row with "Cash Paid" in column T
    fRow = sht.Range("T:T").Find(What:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole).Row
              'then finds actual last row based on column T
    lRow = sht.Cells(sht.Rows.Count, "T").End(xlUp).Row
           sht.Range("AR" & fRow & ":AS" & lRow).Clear
                 ' Determine last row of range
 Set rng = sht.Range("t:t").Find(What:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole)
            lRow = rng.Row
     DestRow = sht.Range("T:T").Find(What:="Cash Paid", LookIn:=xlValues, LookAt:=xlWhole).Row     'To locate LAST row of Input Section to paste copied cells

           For i = 10 To lRow       ' Start row to copy FROM
  Set rng = Range("S" & i)      ' Col# that looking for "Comments" in

  If Not rng.comment Is Nothing Then
        sht.Range("R" & i & ":S" & i).Copy
        sht.Range("ar" & DestRow & ":as" & DestRow).PasteSpecial xlPasteAll 'Destination for copied cells.
                'Temp subed out sht.Range("P" & i).Copy '
                'Temp subed out sht.Range("AR" & DestRow).PasteSpecial xlPasteAll       'Destination for copied cells 
        DestRow = DestRow + 1
     End If
  Next
            sht.Range("AR" & DestRow + 1).Offset(1, 0).Select       ' To shift/activate a cell off the search results
                    Application.ScreenUpdating = True
 End Sub

 

[julhs]

For those that read this later.
Unless some experienced VBA expert comes up with a way to accomplish the outcome to this poste then I have to consider that either, my question was muddled (highly likely) or what I was asking is not possible.
So this post has hit a dead end.
But if interested in a possible alternative solution see the post below, it is a sort of work around.
Specifically my post #6

Add an Application InputBox into code

I need, what I hope is some quick help!!?? I have the code below that does what I want; it Coverts the EFFECT of the Condition Formatting rule to a FIXED interior colour matching the CF effect, it then deletes the rule. What I want to do is incorporate a pop up Inputbox into the existing code...

www.mrexcel.com