Fusionar varias líneas de texto formateado en una sola celda

Question

Espero que la respuesta a esta pregunta me lleve a la pregunta más amplia, que es una pregunta de VBA que publiqué en SO.

Si tengo varias líneas de texto formateado y quiero fusionar ese contenido en una sola celda y no perder ese formato, ¿es posible?

Parece que puedo:

1. Pegue varias líneas de texto en una celda (sin formato).
2. Realice un pegado que generará múltiples celdas para múltiples líneas.

Sin embargo, quiero elcombinaciónde los dos.

Mi problema subyacente es intentar colocar HTML de varias líneas en una sola celda y mantener el formato a través de VBA. Hasta ahora, eso no ha tenido éxito.

Answer 1

Esta solución tiene toda la elegancia de un camión de basura bailando ballet y es tan rápida como el mismo camión atrapado en el tráfico en hora punta, pero funciona:

j = 1

For Each myRange In Range1
    If Range0.Value = vbNullString Then
        Range0.Value = myRange.Value
    Else
        Range0.Value = Range0.Value & Chr$(10) & myRange.Value
    End If
Next myRange

For Each myRange In Range1
    For i = 1 To myRange.Characters.Count
        Range0.Font.Name = myRange.Characters(Start:=j, Length:=1).Font.Name
        Range0.Characters(Start:=j, Length:=1).Font.FontStyle = myRange.Characters(Start:=j, Length:=1).Font.FontStyle
        Range0.Characters(Start:=j, Length:=1).Font.Size = myRange.Characters(Start:=j, Length:=1).Font.Size
        Range0.Characters(Start:=j, Length:=1).Font.Strikethrough = myRange.Characters(Start:=j, Length:=1).Font.Strikethrough
        Range0.Characters(Start:=j, Length:=1).Font.Superscript = myRange.Characters(Start:=j, Length:=1).Font.Superscript
        Range0.Characters(Start:=j, Length:=1).Font.Subscript = myRange.Characters(Start:=j, Length:=1).Font.Subscript
        Range0.Characters(Start:=j, Length:=1).Font.OutlineFont = myRange.Characters(Start:=j, Length:=1).Font.OutlineFont
        Range0.Characters(Start:=j, Length:=1).Font.Shadow = myRange.Characters(Start:=j, Length:=1).Font.Shadow
        Range0.Characters(Start:=j, Length:=1).Font.Bold = myRange.Characters(Start:=j, Length:=1).Font.Bold
        Range0.Characters(Start:=j, Length:=1).Font.Italic = myRange.Characters(Start:=j, Length:=1).Font.Italic
        Range0.Characters(Start:=j, Length:=1).Font.Underline = myRange.Characters(Start:=j, Length:=1).Font.Underline
        Range0.Characters(Start:=j, Length:=1).Font.Color = myRange.Characters(Start:=j, Length:=1).Font.Color
        Range0.Characters(Start:=j, Length:=1).Font.TintAndShade = myRange.Characters(Start:=j, Length:=1).Font.TintAndShade
        Range0.Characters(Start:=j, Length:=1).Font.ThemeFont = myRange.Characters(Start:=j, Length:=1).Font.ThemeFont
        j = j + 1
    Next i
    j = j + 1
Next myRange

¿Dónde Range0está el rango en el que desea copiar las celdas múltiples y Range1contiene todas las celdas que desea copiar (nota: Range0no puede ser un subconjunto de Range1)