Sub Test()
Dim a, e, v, x, rng As Range, i As Long, ii As Long
Set rng = Range("B2:J6")
rng.Copy Range("B23")
With Range("B23")
.Resize(rng.Rows.Count, 5).NumberFormat = "@"
.Offset(, 5).Resize(rng.Rows.Count, 5).NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"
a = .CurrentRegion.Value
End With
For i = LBound(a) To UBound(a)
For Each e In Array(Array(2, 3, 4, 5), Array(6, 7, 8, 9))
x = Application.Index(a, i, e)
v = ReverseArray(x)
If UBound(v) > 0 Then
For ii = LBound(v) To UBound(v)
a(i, ii + e(0)) = v(ii)
Next ii
End If
Next e
Next i
With Range("B23")
.Resize(UBound(a, 1), UBound(a, 2)).Value = a
End With
End Sub
Function ReverseArray(ByVal arr)
Dim v
With CreateObject("System.Collections.ArrayList")
For Each v In arr
If v <> Empty Then .Add v
Next v
.Reverse
ReverseArray = .Toarray
End With
End Function