Sub ConcatWithStyles()
Dim X As Long, Cell As Range, Text As String, Position As Long
Range("A3").Value = Space(Evaluate("SUM(LEN(A1:F1))+COLUMNS(A1:F1)-1"))
Position = 1
Application.ScreenUpdating = False
For Each Cell In Range("A1:F1")
With Range("A3")
.Characters(Position, Len(Cell.Value)).Text = Cell.Characters(1, Len(Cell.Value)).Text
For X = 1 To Len(Cell.Value)
With .Characters(Position + X - 1, 1).Font
.Name = Cell.Characters(X, 1).Font.Name
.Size = Cell.Characters(X, 1).Font.Size
.Color = Cell.Characters(X, 1).Font.Color
.Strikethrough = Cell.Characters(X, 1).Font.Strikethrough
End Sub
Solved by D. Q. in 23 mins