Happens quite often, you have a nice table with data in columns (eg. in months, quarters, years, etc), which you need to convert into a list (eg. for pivots).
This macro does the trick, I have used a macro I found online as a basis, and modified it so you only enter the number of fixed columns, and it will create rows for all of the others.
[vb]
Option Explicit
Sub ColumnsToRows()
Dim a As Variant, b As Variant
Dim i As Long, ii As Long, C As Long, lc As Long, Y As Long, R As Long
Dim x As Range
With ActiveSheet
Application.ScreenUpdating = False
‘Define the number of fixed columns to repeat (all other columns will be defined as new rows)
Y = 7
‘Copy the headers of your fixed columns
Set x = .Range("A1").CurrentRegion.Resize(, Y)
‘Define the range
a = .Cells(1).CurrentRegion
‘Define the last column of the range
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
ReDim b(1 To (UBound(a, 1) * 12) + 1, 1 To Y + 2)
End With
‘Start the action!
For i = 2 To UBound(a, 1)
For C = Y + 1 To lc
ii = ii + 1
For R = 1 To Y
b(ii, R) = a(i, R)
Next R
b(ii, Y + 1) = a(1, C)
b(ii, Y + 2) = a(i, C)
Next C
Next i
‘Put output in sheet ‘results’, create it if it doesn’t exist
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=ActiveSheet).Name = "Results"
With Sheets("Results")
.UsedRange.Clear
.Cells(1, 1).Resize(, Y).Value = x.Value
.Cells(1, Y + 1).Resize(, 2).Value = [{"Period","Amount"}]
.Cells(2, 1).Resize(UBound(b, 1), UBound(b, 2)) = b
.Columns.AutoFit
.Activate
End With
Application.ScreenUpdating = True
End Sub
[/vb]
Base source: here