How to data flip months

Requirement:

The user has Monthly columns that needs to condense down to 4 columns in order to be able to load another BI system.

The user has figured out some VBA where the user can copy and paste into the new format but I do not know how to make it run through the remaining columns.

The columns are based on the following on the data sheet:

Store	Chart1	Name	Chart2	Name	1/31/2017	2/28/2017	3/31/2017
1230	66	CHANGE FUNDS	85	CASH ON HAND	0	0	0
1230	74	DEPOSITORY	104	DEPOSITORY	874744.33	644425.77	700159.89

The ITload tab needs to pull
Column A - Store (this is the same for each month)
Column B - Chart (this is the same for each month)
Column C -is the date at the top of the column being pulled
Column D - is the amounts in the column being pulled (1/31/17 or 2/28/17 and so on)

So on the ITload tab column F or 1/31/17 pulled fine. Now the user just needs to make it copy the remaining columns and add the date.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1204899-data-flip-months

Solution:

Code:

Sub TESTCOPYDisplayData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Sheets("Data").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim Column As Long, x As Long, bottomA As Long, bottomC As Long
    Column = Sheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
    Sheets("ITLoad").Range("A1:D1") = Array("Store", "Chart", "Date", "Amount")
    For x = 6 To Column
        Sheets("Data").Range("A2:B" & LastRow).Copy Sheets("ITLoad").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
        bottomA = Sheets("ITLoad").Range("A" & Rows.Count).End(xlUp).Row
        bottomC = Sheets("ITLoad").Cells(Rows.Count, "C").End(xlUp).Offset(1, 0).Row
        Sheets("ITLoad").Range("C" & bottomC & ":C" & bottomA) = Sheets("Data").Cells(1, x)
        Sheets("Data").Range(Sheets("Data").Cells(2, x), Sheets("Data").Cells(LastRow, x)).Copy Sheets("ITLoad").Cells(Sheets("ITLoad").Rows.Count, 4).End(xlUp).Offset(1, 0)
        Sheets("ITLoad").Range("A1:D" & Sheets("ITLoad").Range("D" & Rows.Count).End(xlUp).Row).AutoFilter Field:=4, Criteria1:="0"
    Next x
    Sheets("ITLoad").Range("D2:D" & Sheets("ITLoad").Range("D" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    If Sheets("ITLoad").AutoFilterMode = True Then Sheets("ITLoad").AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Mumps.