Option Explicit

Sub Rio_ValueHunter()

Dim ArrX As Variant 'For results
Dim RowZ As Long    'How much rows
Dim ColZ As Long    'How much columns
Dim A As Long       'To roll rows
Dim B As Long       'To roll columns
Dim X As Long       'To roll ArrX

ColZ = Cells(1, 1).End(xlToRight).Column
RowZ = Cells(1, 1).End(xlDown).Row
Call Rio_UnMerger(Range(Cells(1, 1), Cells(RowZ, ColZ)))

ReDim ArrX(2, X)
ArrX(0, 0) = "Артикул"
ArrX(1, 0) = "Размеры"
ArrX(2, 0) = "Цена"

For A = 2 To RowZ
      For B = 2 To ColZ
          If Cells(A, B).Value <> "" Then
              X = X + 1
              ReDim Preserve ArrX(2, X)
              ArrX(0, X) = Cells(A, 1).Value
              ArrX(1, X) = Cells(1, B).Value
              ArrX(2, X) = Cells(A, B).Value
              Do While Cells(A, B).Value = Cells(A, B + 1).Value
                  B = B + 1
                  ArrX(1, X) = ArrX(1, X) & "/" & Cells(1, B).Value
              Loop
          End If
      Next B
Next A

Cells(1, ColZ + 2).Resize(X + 1, 3).Value = Application.WorksheetFunction.Transpose(ArrX)
Columns(ColZ + 3).EntireColumn.AutoFit
Cells(1, ColZ + 5).Select

End Sub

Private Sub Rio_UnMerger(RngQ As Range)

Dim RngX As Range
Dim RngA As Range

For Each RngX In RngQ
      If RngX.MergeArea.Cells.Count > 1 Then
          Set RngX = RngX.MergeArea
          RngX.UnMerge
          For Each RngA In RngX
              RngA.Value = RngX.Cells(1, 1).Value
          Next RngA
      End If
Next RngX

End Sub