Reshape data and unpivot

[hpatel517]

Hello all,

I am new to macros and beginning to gain an understanding...not quite at the point where I can write my own yet.

I am looking to take a worksheet and unpivot the data and delete a few columns in the process. I have attached a workbook as an example. The tab "original" has the data in it's current form. The tab "unpivoted" has the columns I want and in the format i am trying to put them in.

Thank you for your help in advance!

-HP

[LeoTaxi]

This will do If

First Year start in Column G
Every Year has 7 columns
Between every Year is a blank column

Sub test()
Dim lr As Long, qtyears As Long, col As Long, x As Long
With Sheets("Original")
    lr = .Range("A" & Rows.Count).End(xlUp).Row
    qtyears = .Cells(1, .Columns.Count).End(xlToLeft).Column - 5
    Sheets("Unpivoted").Range("A1").Resize(1, 8) = Array(.Range("A1"), .Range("B1"), .Range("C1"), .Range("D1"), .Range("E1"), .Range("F1"), "Year", "Total")
    Sheets("Unpivoted").Range("G1", "H1").Font.Bold = True
    For x = 1 To qtyears / 8
        .Range("A2", "F" & lr).Copy Sheets("Unpivoted").Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next
    For col = 7 To qtyears Step 8
        myyear = Left(.Cells(1, col), 4)
        Sheets("Unpivoted").Range("G" & Rows.Count).End(xlUp).Offset(1).Resize(lr - 1, 1) = myyear
        .Cells(2, col + 6).Resize(lr - 1, 1).Copy Sheets("Unpivoted").Range("H" & Rows.Count).End(xlUp).Offset(1)
    Next
End With
Sheets("Unpivoted").Columns.AutoFit
End Sub

Kind regards
Leo

[hpatel517]

This is perfect. Thank you.

I know this may be a stretch but would it be too much to ask to pseudo-code that script so in case the structure changes, I would be able to recognize which line in the code drives that?