Sub TEST2()
Dim x, y(), i&, j&, k&
x = Sheets("TEST").Range("A1").CurrentRegion.Value
ReDim y(1 To UBound(x, 1) * UBound(x, 2), 1 To 5)

For i = 2 To UBound(x)
    For j = 4 To UBound(x, 2)
        k = k + 1
        y(k, 1) = x(i, 1)    'Имя
        y(k, 2) = x(i, 2)    'Дата
        y(k, 3) = x(i, 3)    'Сеть
        y(k, 4) = x(1, j)    'Продукт
        y(k, 5) = x(i, j)    'Количество
    Next j
Next i

With Sheets("result_example").Range("E1").CurrentRegion
    .Offset(2).ClearContents
    .Offset(2).Resize(k).Value = y()
End With
End Sub

Sub Rio_Unpivot()
    Dim aMeasures, aValues, wsResult As Worksheet, iResult&, iStep&, iValues&
    With ThisWorkbook.Worksheets("TEST")
        aMeasures = .Cells(1, 1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 3).Value
        aValues = .Cells(1, 4).Resize(UBound(aMeasures), .UsedRange.Columns.Count - 3).Value
    End With
    Set wsResult = ThisWorkbook.Worksheets("result_example")
    wsResult.UsedRange.Delete
    wsResult.Range("A1").Resize(1, 5).Value = Array("Имя", "Дата", "Сеть", "Товар", "Количество")
    iResult = 2: iStep = UBound(aValues, 2)
    With Application.WorksheetFunction
        For iValues = 2 To UBound(aValues)
            wsResult.Cells(iResult, 1).Resize(iStep, 3).Value = .Index(aMeasures, iValues)
            wsResult.Cells(iResult, 4).Resize(iStep, 1).Value = .Transpose(.Index(aValues, 1))
            wsResult.Cells(iResult, 5).Resize(iStep, 1).Value = .Transpose(.Index(aValues, iValues))
            iResult = iResult + iStep
        Next iValues
    End With
End Sub