Sub Redesigner2()
' оригинал http://www.planetaexcel.ru/tip.php?aid=87
' инструкция по использованию - там-же

    Dim InVal, OutVal
    Dim j&, k&, i&
    
    With Selection
        InVal = .Value
        ReDim OutVal(1 To (.Rows.Count - 1) * (.Columns.Count - 3), 1 To 4)
    End With

    i = 1
    For j = 2 To UBound(InVal, 1)
    For k = 4 To UBound(InVal, 2)
        OutVal(i, 1) = InVal(j, 1)
        OutVal(i, 2) = InVal(j, 2)
        OutVal(i, 3) = InVal(j, 3)
        OutVal(i, 4) = InVal(j, k)
        i = i + 1
    Next k, j

    Worksheets.Add.[A2].Resize(UBound(OutVal, 1), 4).Value = OutVal

    Erase InVal, OutVal
End Sub