HI Bill,

The explanation of your code does make sense now!

If you still want to try copying purely the CF's, try the following (watch
out for line-wrap) -

Sub Test()
Dim rSource As Range
Dim rDest As Range

   If ActiveCell Is Nothing Then Exit Sub
   Set rSource = ActiveSheet.Range("B2")
   Set rDest = ActiveSheet.Range("D2:D10")

   CopyCF rSource, rDest

End Sub

Sub CopyCF(rSource As Range, rDest As Range)
Dim vIntFmts(0 To 2), vFontFmts(0 To 7), vBdrFmts(1 To 4, 0 To 2)
Dim f1 As String, f2 As String
Dim nOp As Long, nType As Long
Dim fc As FormatCondition

   ' check rSource is a single cell and has FC
   If rSource.Count > 1 Or _
      rSource(1).FormatConditions.Count = 0 Then
       Exit Sub
   End If

   rDest.FormatConditions.Delete
   For Each fc In rSource.FormatConditions
       Erase vIntFmts: f2 = ""
       nType = fc.Type
       If nType = 2 Then
           nOp = 0
       Else
           nOp = fc.Operator
       End If

       f1 = Application.ConvertFormula(fc.Formula1, xlA1, xlR1C1)
       f1 = Application.ConvertFormula(f1, xlR1C1, xlR1C1, , ActiveCell)

       On Error Resume Next
       f2 = fc.Formula2
       If Len(f2) Then
           f2 = Application.ConvertFormula(f2, xlA1, xlR1C1)
           f2 = Application.ConvertFormula(f2, xlR1C1, xlR1C1, ,
ActiveCell)
       End If
       On Error GoTo 0

       With fc.Interior
           vIntFmts(0) = .ColorIndex
           vIntFmts(1) = .Pattern
           vIntFmts(2) = .PatternColorIndex
       End With
       With fc.Font
' trap any/all of following to vFontFmts if anticipated required
'Bold, Colorindex, Italic, Name, Size, StrikeThrough, Superscript, Underline
       End With

       With fc.Borders
'loop .Item(1) to .Item(4)
' trap any/all of following to vBdrFmts if necessary
'  LineStyle, Weight, Colorindex
       End With

       With rDest.FormatConditions.Add(nType, nOp, f1, f2)

           With .Interior
If Not IsNull(vIntFmts(0)) Then .ColorIndex = vIntFmts(0)
If Not IsNull(vIntFmts(1)) Then .Pattern = vIntFmts(1)
If Not IsNull(vIntFmts(2)) Then .PatternColorIndex = vIntFmts(2)
           End With

' similarly apply Font & Border formats if trapped

       End With
   Next

End Sub

Include Font & Border formats if/as required.

As written, should be OK to copy CF in one cell to a block of cells BUT only
if the can do the same manually. AS mentioned before that means
relative/absolute addressing should be correct, which otherwise might not be
necessary.

The main difficulty above is getting those ConvertFormula's correct. In a
light test all seemed OK with a mixture of CF types & relative/absolute
addresses, but test thoroughly. I didn't test copying CF's NOT on the
activesheet, and anticipate a bit more work to cater for that if necessary.

Regards,
Peter T