transpose column to a range calculate and transpose to new table loop

Well, I probably do not really follow your idea, but let's try another approach:

Sub test2()
Dim i As Long, j As Long
Range("J4:O13").ClearContents
For i = 2 To 7
  For j = 4 To 13
    Cells(j, i + 8).Formula = "=" & Cells(j, i).Address & Mid(Cells(18, j - 2).Formula, InStr(Cells(18, j - 2).Formula, "*"))
Next j, i
End Sub