Pivot table will not work for this. Yes, you can remove the structure
after rearranging, but it won't do what you want.
I do however have some code that will help. I adapted it to solve
your problem.
Public Sub splitByMonth()
'***********************************************************
'****************** constant declarations ******************
'***********************************************************
'column on this worksheet containing code
Const iSourceGLcol As Long = 1
'column on this worksheet containing date
Const iSourceDateRow As Long = 1
'row on this worksheet containing the first code
Const iSourceFirstRow As Long = 2
'destination worksheet name
Const strWshName As String = "Transpose"
'column on destination worksheet to contain code
Const iDestGLcol As Long = 1
'column on destination worksheet to contain date
Const iDestDateCol As Long = 2
'column on destination worksheet to contain amount
Const iDestAmountCol As Long = 3
'***********************************************************
'****************** variable declarations ******************
'***********************************************************
'row and column on source worksheet
Dim iCol As Long
Dim iRow As Long
'destination row on import data worksheet
Dim iRowDest As Long
'import data worksheet
Dim wsh As Excel.Worksheet
'***********************************************************
'******************** execution section ********************
'***********************************************************
Application.ScreenUpdating = False
Set wsh = ThisWorkbook.Worksheets.Add
' check for worksheet from previous runs
' if rename operation fails, it's because
' a worksheet by that name already exists
On Error Resume Next
wsh.Name = strWshName
On Error GoTo 0
'confirm deletion
If wsh.Name <> strWshName Then
If VBA.MsgBox("Import data worksheet exists. Delete?", _
vbYesNo + vbInformation) = vbNo Then
Application.DisplayAlerts = False
wsh.Delete
Application.DisplayAlerts = True
Exit Sub
End If
Application.DisplayAlerts = False
ThisWorkbook.Worksheets(strWshName).Delete
Application.DisplayAlerts = True
wsh.Name = strWshName
End If
iRowDest = 1
For iRow = iSourceFirstRow To Me.UsedRange.Rows.Count
' process each month's amount
' assuming there are 12 months, and
' first month follows code column immediately
For iCol = iSourceGLcol + 1 To iSourceGLcol + 12
wsh.Cells(iRowDest, iDestGLcol).Value = _
Me.Cells(iRow, iSourceGLcol).Value
wsh.Cells(iRowDest, iDestDateCol).Value = _
Me.Cells(iSourceDateRow, iCol).Value
wsh.Cells(iRowDest, iDestAmountCol).Value = _
Me.Cells(iRow, iCol).Value
iRowDest = iRowDest + 1
Next iCol
Next iRow
Application.ScreenUpdating = True
End Sub
Let me know if you have problems with it.
