Excel has made this question easier to answer and it can be done in a single formula. It requires some newer functions such as ByRow and ByCol but these are scheduled to be available to everyone (someday).
To recap:
 No VBA
 Dynamic for multiple axes in both rows and columns data ranges
 Can be converted to lambda (in desktop version)
With the below dataset pasted in cell A1
, you could use this Lambda function to unpivot or flatten the data:
Starting Dataset
See sample file here
(cell A1) 


Jan 
Feb 
Mar 
Apr 
May 



Actual 
Actual 
Actual 
Budget 
Budget 
Disney 
Tickets 
Revenue 
507 
607 
707 
807 
907 
Disney 
Movies 
Costs 
508 
608 
708 
808 
908 
StarWars 
Promo 
Revenue 
509 
609 
709 
809 
909 
StarWars 
Vader 
Taxes 
510 
610 
710 
810 
910 
Marvel 
HR 
Costs 
511 
611 
711 
811 
911 
Stand Alone Formula
=LET(dataRng,D3:H7, rowAxis,A3:C7, colAxis,D1:H2,
iCol,COLUMN(INDEX(rowAxis,1,1)), amountCol,TOCOL(dataRng), totalCells,COUNTA(amountCol),
HSTACK(
INDEX(rowAxis,
INT(SEQUENCE(totalCells,1,0,1)/COLUMNS(dataRng))+1,
BYCOL(INDEX(rowAxis,1,), LAMBDA(aCol,COLUMN(aCol) iCol +1))),
INDEX(colAxis,
SEQUENCE(1,ROWS(colAxis),1,1),
MOD(SEQUENCE(totalCells,1,0,1),COLUMNS(dataRng))+1),
amountCol))
Lambda Formula
=LAMBDA(dataRng,rowAxis,colAxis,
LET(iCol,COLUMN(INDEX(rowAxis,1,1)), amountCol,TOCOL(dataRng), totalCells,COUNTA(amountCol),
HSTACK(
INDEX(rowAxis,
INT(SEQUENCE(totalCells,1,0,1)/COLUMNS(dataRng))+1,
BYCOL(INDEX(rowAxis,1,), LAMBDA(aCol,COLUMN(aCol) iCol +1))),
INDEX(colAxis,
SEQUENCE(1,ROWS(colAxis),1,1),
MOD(SEQUENCE(totalCells,1,0,1),COLUMNS(dataRng))+1),
amountCol
)))(D3:H7,A3:C7,D1:H2)
Also, if you did happen to want a vba solution, I used to use this:
Function unPivotData(theDataRange As Range, theColumnRange As Range, theRowRange As Range, _
Optional skipZerosAsTrue As Boolean, Optional includeBlanksAsTrue As Boolean, Optional columnsFirst As Boolean)
'Set effecient range
Dim cleanedDataRange As Range
Set cleanedDataRange = Intersect(theDataRange, theDataRange.Worksheet.UsedRange)
'tests Data ranges
'Use intersect address to account for users selecting full row or column
If cleanedDataRange.EntireColumn.Address <> Intersect(cleanedDataRange.EntireColumn, theColumnRange).EntireColumn.Address Then
unPivotData = "datarange missing Column Ranges"
ElseIf cleanedDataRange.EntireRow.Address <> Intersect(cleanedDataRange.EntireRow, theRowRange).EntireRow.Address Then
unPivotData = "datarange missing row Ranges"
ElseIf Not Intersect(cleanedDataRange, theColumnRange) Is Nothing Then
unPivotData = "datarange may not intersect column range. " & Intersect(cleanedDataRange, theColumnRange).Address
ElseIf Not Intersect(cleanedDataRange, theRowRange) Is Nothing Then
unPivotData = "datarange may not intersect row range. " & Intersect(cleanedDataRange, theRowRange).Address
End If
'exits if errors were found
If Len(unPivotData) > 0 Then Exit Function
Dim dimCount As Long
dimCount = theColumnRange.Rows.Count + theRowRange.Columns.Count
Dim aCell As Range, i As Long, g As Long, tangoRange As Range
ReDim newdata(dimCount, i)
'loops through data ranges
For Each aCell In cleanedDataRange.Cells
If aCell.Value2 = "" And Not (includeBlanksAsTrue) Then
'skip
ElseIf aCell.Value2 = 0 And skipZerosAsTrue Then
'skip
Else
ReDim Preserve newdata(dimCount, i)
g = 0
'gets DimensionMembers members
If columnsFirst Then
Set tangoRange = Union(Intersect(aCell.EntireColumn, theColumnRange), _
Intersect(aCell.EntireRow, theRowRange))
Else
Set tangoRange = Union(Intersect(aCell.EntireRow, theRowRange), _
Intersect(aCell.EntireColumn, theColumnRange))
End If
For Each gcell In tangoRange.Cells
newdata(g, i) = IIf(gcell.Value2 = "", "", gcell.Value)
g = g + 1
Next gcell
newdata(g, i) = IIf(aCell.Value2 = "", "", aCell.Value)
i = i + 1
End If
Next aCell
unPivotData = WorksheetFunction.Transpose(newdata)
End Function