Sub tt()
    Dim i&, ii&, x&, r1 As Range, r2 As Range

    On Error Resume Next
    Set r1 = Application.InputBox(Prompt:="Выберите исходную ТАБЛИЦУ", Title:="Диапазон", Type:=8)
    Set r2 = Application.InputBox(Prompt:="Укажите любую ЯЧЕЙКУ куда выгружать РЕЗУЛЬТАТ", Title:="Диапазон", Type:=8)
    On Error GoTo 0
    If r1 Is Nothing Then Exit Sub
    If r2 Is Nothing Then Exit Sub

    Application.ScreenUpdating = False
    For i = 2 To r1.Columns.Count
        For ii = 2 To r1.Rows.Count
            x = x + 1
            r2.Cells(x, 1) = r1.Cells(ii, 1)
            r2.Cells(x, 2) = r1.Cells(1, i)
            r2.Cells(x, 3) = r1.Cells(ii, i)
        Next
    Next
    Application.ScreenUpdating = True
End Sub