How can I copy Excel cells with rich text formatting but not the global cell format?

Question

Using VBA, I'm copying the value of one cell to another:

Dim s As Range
Dim d As Range
Set s = Range("A1")
Set d = Range("B2")
d.Value = s.Value

This works fine, but if the source contains rich text formatting, the formatting is lost.

I could copy the entire cell, formats and all:

s.Copy d

But this brings along not just rich text formatting, but also global formats on the cell -- background color, borders, etc. I'm only interested in copying formats that apply to portions of the text (for example, one word in a sentence being in bold).

I've also tried copying the format of each character:

For ci = 1 to Len(sourcevalue)
   d.Characters(ci, 1).Font.Bold = s.Characters(ci, 1).Font.Bold
Next

The actual code for the above includes italics, underlines, etc., and caches Characters() as an object for speed, but still, the performance is way too slow for production use.

The last option I can think of is to copy the cell with formatting, then undo any changes to background color or pattern, borders, font name/size, etc.:

bg = d.Interior.ColorIndex
s.Copy d
d.Interior.ColorIndex = bg

This still seems kludgy, it's difficult to save off all of the formats to be re-applied, and I can't "undo" formatting like bold, italics, etc. that could either be applied at a cell or character level without erasing the character-level settings.

Any other options out there? The formatting in the Excel OpenOfficeXML file is stored with ranges of characters, but it doesn't appear these formatted ranges are available via the API, at least as far as I can find.

Edit: Using KazJaw's approach below, I was able to get what I needed with the following code:

Dim TmpFormat As Range
Set TmpFormat = Range("$XFD$1")
Dest.Copy
TmpFormat.PasteSpecial xlPasteFormats
Source.Copy
Dest.PasteSpecial xlPasteAll
TmpFormat.Copy
Dest.PasteSpecial xlPasteFormats
Dest.Font.Name = TmpFormat.Font.Name
Dest.Font.Size = TmpFormat.Font.Size
TmpFormat.ClearFormats

This temporarily preserves the cell formatting of my destination cell in the last cell of the first row, copies the source with all formatting, pastes back the formatting in the temp cell, and finally also copies back the preserved overall font and size (which in my case I don't want to copy over from the source). Finally, the temp cell is cleared so it doesn't impact the worksheet dimensions.

It's an imperfect solution, especially since it relies on the clipboard, but the performance is good and it does what it needs to do.

Answer 1

I've just made some test and I'm bit surprised with results which could be solution for you or just a tip to explore it more.

Imagine we have this situation at the beginning:

If you run this simple code:...

Sub PossibleSolution()

    Range("A1").Copy     'full formatted cell
    Range("A3").PasteSpecial xlPasteAll
    Range("A2").Copy     'clear format cell
    Range("A3").PasteSpecial xlPasteFormats

End Sub

...you will get the following result:

Answer 2

Range.Value has an optional RangeValueDataType parameter (11 is xlRangeValueXMLSpreadsheet):

 Range("B2").Value(11) = Range("A1").Value(11)