左側の表の列幅を右側表にコピーする。
「複数列へ展開」マクロを使用した後に、左表の列幅を手修正後マクロでコピーします。

E列にマウスポイントを置いた後、下のマクロ実行、上の場合空欄含め14列の14入力

マクロも完璧では無いです。
（ググってパクって意味不明コードをコピーして使ってます）

Sub copy_列幅調整() '複数列へ展開後用

Dim retu As Long
Dim retu_frg As Variant

retu = ActiveCell.Column
retu_frg = Application.InputBox(Prompt:="先頭列から最後の1列の空欄含め列単位は何列にしますか？", Type:=1)
If StrConv(retu_frg, vbLowerCase) = "false" Then Exit Sub

retu_frg = retu_frg + 1

For i = 0 To 500

If Cells(1, retu - 2 + retu_frg * 2 + (retu_frg - 1) * i) = "" Then End

Range(Cells(1, retu), Cells(1, retu + retu_frg - 2)).Copy
Cells(1, retu - 2 + retu_frg * 2 + (retu_frg - 1) * i).PasteSpecial Paste:=xlPasteColumnWidths

If Cells(1, retu - 2 + retu_frg * 2 + (retu_frg - 1) * i) = "" Then Exit For

Application.CutCopyMode = False

Next i
End Sub

「複数列へ展開」マクロも修正しました。

Sub 複数列へ展開()
Dim yiti As Long, retu As Long, gyou As Long
Dim Lastgyou As Long, x As Long
Dim retu_frg As Variant, prspan As Variant

retu = ActiveCell.Column
gyou = ActiveCell.Row

If Cells(gyou, retu) = "" Then End

retu_frg = Application.InputBox(Prompt:="列単位は何列にしますか？", Type:=1)
If StrConv(retu_frg, vbLowerCase) = "false" Then Exit Sub

retu_frg = retu_frg + 1

prspan = Application.InputBox(Prompt:="行単位は何行にしますか？", Type:=1)
If StrConv(prspan, vbLowerCase) = "false" Then Exit Sub

Lastgyou = Cells(Rows.Count, retu).End(xlUp).Row

Lastretu = Int((Lastgyou + 1 - gyou) / prspan + 2)
yiti = 0

For x = 2 To Lastretu

Range(Cells(yiti + gyou, retu), Cells(yiti + gyou + prspan - 1, retu + retu_frg)).Copy Cells(gyou, retu + retu_frg * x)
yiti = yiti + prspan

Next x

End Sub