If you copy and paste from Word into Excel, and there are line breaks, these turn up as different cells in Excel instead of just one big cell. If you have some formatting in the cell that you'd like to keep, and you try to copy just the text, Excel will lose the formatting of the cell.
To retain all the formatting, you can use the following macro, which works fairy quickly because it checks for a run a characters with the same formatting before changing the formatting. If you try to change each character one at a time, it takes a long time (due to the way that Excel handles character formatting changes).
Below is a modified version of the macro found in this forum https://answers.microsoft.com/en-us/msoffice/forum/all/how-to-merge-two-cells-and-keep-the-different/d33d91cb-16db-4008-8cf4-a0a06caa7095, except it fixes some bugs and also speeds up the merge (by checking for a run of characters):
Sub MergeCellsWithFormmattingFast()
Dim Source As Range, Dest As Range, This As Range
Dim FontProperties, Delimiter, Item, Value
Dim f As Long, i As Long
'Names of all font properties
FontProperties = Array("Bold", "Color", "ColorIndex", "FontStyle", "Italic", "Name", "Size", "Strikethrough", "Subscript", "Superscript", "ThemeFont", "TintAndShade", "Underline")
'Errors off, we handle all by oruself
' On Error Resume Next
'Get the user input
If Selection.Rows.Count > 1 Then
Set Source = Selection
Else
Set Source = Application.InputBox("Select all cells to combine", "Source", Selection.Address, Type:=8)
If Source Is Nothing Then Exit Sub
End If
If Source.Offset(Source.Rows.Count).Rows(1).Value = "" Then
Set Dest = Source.Offset(Source.Rows.Count).Rows(1)
Else
Do
Set Dest = Application.InputBox("Select the destination cell", "Dest", Selection.Address, Type:=8)
If Dest Is Nothing Then Exit Sub
If Not Intersect(Source, Dest) Is Nothing Then
MsgBox "The destination cell can not be inside the source cells", vbExclamation, "Error"
End If
Loop Until Intersect(Source, Dest) Is Nothing
End If
Delimiter = vbLf
'Copy all values into the destination cell
Dest.Clear
For Each This In Source
Dest = Dest & This & Delimiter
Next
Dest = Left(Dest, Len(Dest) - Len(Delimiter))
'Now we have to copy over the font property for each char!
Dim startIndex As Long
Dim endIndex As Long
Dim currentFont As Object
Dim previousFont As Object
For Each This In Source
startIndex = 1
Set previousFont = This.Characters(1, 1).Font
For i = 2 To This.Characters.Count
Set currentFont = This.Characters(i, 1).Font
' Check if font properties change
Match = True
For Each Item In FontProperties
If CallByName(previousFont, Item, VbGet) <> CallByName(currentFont, Item, VbGet) Then
Match = False
Exit For
End If
Next Item
If Not Match Then
' It's changed, apply the formatting to just this run
endIndex = i - 1
With Dest.Characters(f + startIndex, endIndex - startIndex + 1)
For Each Item In FontProperties
Value = CallByName(previousFont, Item, VbGet)
If Not IsNull(Value) Then
CallByName .Font, Item, VbLet, Value
End If
Next Item
End With
startIndex = i
End If
Set previousFont = currentFont
Next i
' Apply formatting to last run
With Dest.Characters(f + startIndex, This.Characters.Count - startIndex + 1)
For Each Item In FontProperties
Value = CallByName(previousFont, Item, VbGet)
If Not IsNull(Value) Then
CallByName .Font, Item, VbLet, Value
End If
Next Item
End With
f = f + Len(This) + Len(Delimiter)
Next
End Sub