Rich Text from Autoshape to Cell
 

I have a series of shapes that include text. They are used to document
assumptions in various sheets. I have a macro (see simplified version
below) that transfers the contents of these "Note" boxes to a sheet.
Users sometimes format the text in the "Note" boxes. Is there a way, I
can transfer the formatting along with the text?

Sub TransferNotes()
r = 1

For Each shp In Sheets("Staff Time").Shapes
If Left(shp.name, 6) = "tbNote" Then
For x = 1 To shp.TextFrame.Characters.Count Step 250
theText = shp.TextFrame.Characters(Start:=x,
Length:=250).Text
Next

Sheets("Assumptions").Cells(r, 2).Value = Trim(theText)

r = r + 2
End If
Next shp

End Sub

~~~~~~~~~~~~~~~
Thanks for the help.

- John