Concatenating with Formats intact

[tempaccount]

I have two rows of cells I want to concatenate and maintain their formats. One is text and the other is a superscript "(1)"

So basically I have a table like this
Column-A Column-F Column-H

Column A contains the names, Column F contains a column of cells that are all superscript "(1)", and Column H is where I want the combined word to be
A=HELLOWORLD
F=(1)
H=HELLOWORLD

(1)​

I hope that makes sense. I found code on an old thread here but it only works for the single cell mentioned in the formula. Is it possible to make it loop or work for all cells in the row till the end or to even make it work to whatever relevant cell I have as a macro function(eg I highlight a Hx and it will concatenate Ax and Fx).

 

[tempaccount]

Here is the formula I was referring too.

Option Explicit

Sub superscriptconcatenate()
Call concatenate_cells_formats(Range("AB650"), Range("E650,AA650"))
End Sub

Sub concatenate_cells_formats(cell As Range, source As Range)
'Erik Van Geit
'060424

Dim e As Range
Dim i As Integer

i = 1
With cell
.Value = vbNullString
.ClearFormats
For Each e In source
.Value = .Value & " " & e
Next e
.Value = Trim(.Value)
For Each e In source
With .Characters(Start:=i, Length:=Len(e)).Font
.Name = e.Font.Name
.FontStyle = e.Font.FontStyle
.Size = e.Font.Size
.Strikethrough = e.Font.Strikethrough
.superscript = e.Font.superscript
.Subscript = e.Font.Subscript
.OutlineFont = e.Font.OutlineFont
.Shadow = e.Font.Shadow
.Underline = e.Font.Underline
.ColorIndex = e.Font.ColorIndex
End With
.Characters(Start:=i + Len(e), Length:=1).Font.Size = 1
i = i + Len(e) + 1
Next e
End With

End Sub