Paste a HTML table into Excel, how to keep the line break in cell

Question

I have a simple html table, for example, just one cell, but when I copy the dom node, and paste it into excel, it will be recognize as two rows, How to make Excel get the correc

Answer 1

What about using a macro with e.g. the following code?

• TransformingPaste1(): however, this fails on my machine (still multiple cells)

• gets the clipboard text
• pastes a transformed version using mso-data-placement:same-cell
• restores the original clipboard text

• TransformingPaste2(): pastes in single cell on my machine, keeping the formatting etc., but results in a space rather than a newline because you're still pasting HTML

• gets the clipboard text
• pastes a transformed version using vbCrLf
• restores the original clipboard text

• TransformingPaste3(): pastes in single cell on my machine, with a newline, but loses the formatting etc. (current implementation) – see note with link!

• gets the clipboard text
• pastes a transformed version using a self-defined token
• restores the original clipboard text
• post-processes the cells, replacing the token by newlines – might be improved…

Modify to what best suits your needs, e.g. using regex to perform the replacements, but I hope this gets you on your way :]

Function GetClipboardText() As String
    Dim BufObj As MSForms.DataObject
    Set BufObj = New MSForms.DataObject
    BufObj.GetFromClipboard
    GetClipboardText = BufObj.GetText
End Function

Function SetClipboardText(ByRef text As String)
    Dim BufObj As MSForms.DataObject
    Set BufObj = New MSForms.DataObject
    BufObj.SetText text
    BufObj.PutInClipboard
End Function

Function PreProcess(ByRef text As String, ByRef find As String, ByRef replace As String) As String
    PreProcess = Application.WorksheetFunction.Substitute(text, find, replace)
End Function

Function PostProcess(ByRef find As String, ByRef replace As String)
    Dim rCell As range
    For Each rCell In Selection
        'TODO: e.g. combine with answers from http://stackoverflow.com/questions/2192730/merge-contents-of-2-excel-cells-keeping-character-format-intact-using-vba
        rCell.Formula = Application.WorksheetFunction.Substitute(rCell.Formula, find, replace)
    Next
End Function

Sub TransformingPaste1()
    Dim OrigText As String
    Dim TempToken As String
    Dim PasteText As String
    Dim sSelAdd As String
    OrigText = GetClipboardText
    PasteText = PreProcess(OrigText, "", "")
    SetClipboardText PasteText
    'Selection.PasteSpecial "Unicode Text"
    ActiveSheet.Paste
    SetClipboardText OrigText
    Application.CutCopyMode = False
End Sub

Sub TransformingPaste2()
    Dim OrigText As String
    Dim TempToken As String
    Dim PasteText As String
    Dim sSelAdd As String
    OrigText = GetClipboardText
    PasteText = PreProcess(OrigText, "
", vbCrLf)
    SetClipboardText PasteText
    ActiveSheet.Paste
    SetClipboardText OrigText
    Application.CutCopyMode = False
End Sub

Sub TransformingPaste3()
    Dim OrigText As String
    Dim TempToken As String
    Dim PasteText As String
    Dim sSelAdd As String
    OrigText = GetClipboardText
    TempToken = "#mybr#"
    PasteText = PreProcess(OrigText, "
", TempToken)
    SetClipboardText PasteText
    ActiveSheet.Paste
    SetClipboardText OrigText
    PostProcess TempToken, vbLf
    Application.CutCopyMode = False
End Sub