Multiple Columns into 2 Columns

Hi all,

I am looking for help so that a tedious becomes quick and fun.

In a worksheet I have data which has been submitted as follow:

Rep Dealer Div SKU Period1 Period2 Perdiod3 Period4
Bob 1234 AA SKU1 2 0 0 2
Bob 1234 AA SKU2 2 2 0 2
Bob 1234 AA SKU3 1 0 2 0
Bob 1234 AA SKU4 2 2 1 0

My desired outcome would be:

Rep Dealer Div SKU Period QTY
Bob 1234 AA SKU1 Period1 2
Bob 1234 AA SKU1 Period2 0
Bob 1234 AA SKU1 Period3 0
Bob 1234 AA SKU1 Period4 2
Bob 1234 AA SKU2 Period1 2
Bob 1234 AA SKU2 Period2 2
Bob 1234 AA SKU2 Period3 0
Bob 1234 AA SKU2 Period4 2

Essentially flattening out the data so that It can be used in a Access and PowerPivot.

Is there a way to do this in VBA? Note that my knowledge of VBA is Freshman level.

Thanks in advance for your help,




assuming that data is on Sheet1 (change name as needed)

expected results in a new sheet



take a look here...


Save As, your Workbook with extension .xlsm (macros enabled)


3.1) press ALT+F11 to open Visual Basic

3.2) on the ribbon, select: Insert > module and paste the code below on the right


Sub ConvertData()

'Mar 17, 2015

Const N As Long = 2 '<<< data starts in row 2
Const c As Long = 4 '<<number of periods
Dim ws As Worksheet
Set ws = Sheets("Sheet1") '<< source sheet name, change
Dim r As Long, x As Long, t As Long
r = ws.Cells(Rows.Count, "A").End(xlUp).Row
Application.ScreenUpdating = False

[A1].PasteSpecial xlPasteValues

[E1].Value = "Period"
[F1].Value = "Qty"
t = 2
For x = N To r
ws.Cells(x, "A").Copy
Cells(t, "A").Resize(c).PasteSpecial xlPasteValues
ws.Cells(x, "B").Resize(, 3).Copy
Cells(t, "B").Resize(c).PasteSpecial xlPasteValues
ws.Cells(1, "E").Resize(, c).Copy
Cells(t, "E").PasteSpecial xlPasteValues, Transpose:=True
ws.Cells(x, "E").Resize(, c).Copy
Cells(t, "F").PasteSpecial xlPasteValues, Transpose:=True
t = Cells(Rows.Count, "A").End(xlUp).Row + 1
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

3.3) Press ALT+Q to Close Visual Basic


To run the macro, press ALT+F8, 

select: ConvertData from the list and click the run button.


add a button and assign the vba macro

Office 365 on Windows 10

Did this solve your problem?

Sorry this didn't help.

Great! Thanks for marking this as the answer.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this response?

Thanks for your feedback.


Question Info

Last updated February 24, 2018 Views 74 Applies to: