Option Base 1
Private Sub ggg()
     Const NumCols% = 5
     Dim NumRows&
     Dim strAddr$, strTmp$
     Dim strFind(), strReplace(), Arr2()
     Dim Arr As Variant
     Dim rng As Range, rng2 As Range
      With Application
         If Not ActiveSheet Is Me Or .Index(Selection, 1, 0).Count > 1 Then Exit Sub
         strAddr = Selection.Address(, , .ReferenceStyle)
         Set rng = Selection.Offset(, 1)
         strFind = Array(""")" & vbLf & "(" & ChrW(20135) & ChrW(21697) & ChrW(23646) & ChrW(24615) & ":Color:""", _
                         """)" & vbLf & "(" & ChrW(21830) & ChrW(23478) & ChrW(32534) & ChrW(30721) & ":""", _
                         """)" & vbLf & "(" & ChrW(20135) & ChrW(21697) & ChrW(25968) & ChrW(-28209) & ":""", _
                         """" & ChrW(12289) & "Size:""")
         strReplace = Array(""")" & vbLf & """", _
                            """" & vbLf & """")
         Arr = Evaluate("transpose(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(" & strAddr & "," & _
                         strFind(1) & "," & strReplace(1) & ")," & strFind(2) & "," & strReplace(2) & ")," & _
                         strFind(3) & "," & strReplace(2) & ")," & strFind(4) & "," & strReplace(2) & _
                         "),"" piece)"",""""))")
         If Selection.Count = 1 Then: strTmp = Arr: Else strTmp = Join(Arr, vbLf)
         Arr2 = .Transpose(Split(strTmp, vbLf))
         NumRows = UBound(Arr2) \ NumCols
         Arr = .Index(.Index(Arr2, Evaluate("(ROW(" & Cells(1).Address(, , _
               .ReferenceStyle) & ":INDEX(" & Columns(1).Address(, , .ReferenceStyle) & "," & NumRows & _
               "))-1)*" & NumCols & "+COLUMN(" & Cells(1).Address(, , .ReferenceStyle) & ":INDEX(" & _
               Rows(1).Address(, , .ReferenceStyle) & "," & NumCols & "))")), Evaluate("ROW(" & _
               Cells(1).Address(, , .ReferenceStyle) & ":INDEX(" & Columns(1).Address(, , _
               .ReferenceStyle) & "," & NumRows & "))"), Array(1, 4, 5, 2, 3))
     End With
     With Worksheets("New format")
         With .[B1].Offset(.Cells(.Rows.Count, 1).End(xlUp).Row).Resize(NumRows, NumCols)
             .NumberFormat = "general": .Columns(2).NumberFormat = "@": .Value = Arr
             With .Resize(1, 1).Offset(, -1)
                 Set rng2 = .Resize(NumRows)
                 .NumberFormat = "general"
                 .FormulaArray = "=COUNT(1/(" & .Offset(, 1).Address & ":" & .Offset(, 1).Address(0, 0) & "<" & _
                    .Offset(-1, 1).Address & ":" & .Offset(-1, 1).Address(0, 0) & "))"
                 .AutoFill rng2: Arr = Application.Index(rng, rng2)
                 rng2.NumberFormat = "@": rng2.Value = Arr
             End With
             .Replace ChrW(12304) & "*" & ChrW(12305) & " ", "", 2, 1
         End With
     End With
End Sub