How do I stack columns?

[Guest]

Hi, I've got the following table:
Site Product Line Sub-division General Turnover YTD 2007 .....
abc abcd xyz 123 456
lkj lkjh uio 897 589

For each Site there are 13 metrics (columns: D, F, H, J....) and also an
Year to Date value for each of the 13 metrics in colunmns E, G, I ...). I
would like to stack Column D to AC by Site on a Table like this:

Site Product Line Sub-division Metric YTD 2007
abc abcd xyz (info column D) (Info column E)
abc abcd xyz (Info column F) (Info Column G)

Can somebody help me?

 

[Guest]

Try code below. If you have a header row then change RowCount from 1 to 2

Sub stackcol()

Application.CutCopyMode = False
RowCount = 1
Do While Not IsEmpty(Cells(RowCount, "A"))


Rows((RowCount + 1) & ":" & (RowCount + 12)). _
Insert Shift:=xlDown
Range(Cells(RowCount, "A"), Cells(RowCount, "C")).Copy _
Destination:=Range(Cells(RowCount + 1, "A"), _
Cells(RowCount + 12, "A"))
FirstRow = RowCount
RowCount = RowCount + 1
For CopyCount = 0 To 11

Range(Cells(FirstRow, "F"), Cells(FirstRow, "G")). _
Offset(0, 2 * CopyCount).Copy _
Destination:=Cells(RowCount, "D")

RowCount = RowCount + 1
Next CopyCount

Range(Cells(FirstRow, "F"), Cells(FirstRow, "AC")) = ""
Loop

End Sub

 

[Guest]

Hey Joel, Thanks a lot!
It works great!

Try code below. If you have a header row then change RowCount from 1 to 2

Sub stackcol()

Application.CutCopyMode = False
RowCount = 1
Do While Not IsEmpty(Cells(RowCount, "A"))


Rows((RowCount + 1) & ":" & (RowCount + 12)). _
Insert Shift:=xlDown
Range(Cells(RowCount, "A"), Cells(RowCount, "C")).Copy _
Destination:=Range(Cells(RowCount + 1, "A"), _
Cells(RowCount + 12, "A"))
FirstRow = RowCount
RowCount = RowCount + 1
For CopyCount = 0 To 11

Range(Cells(FirstRow, "F"), Cells(FirstRow, "G")). _
Offset(0, 2 * CopyCount).Copy _
Destination:=Cells(RowCount, "D")

RowCount = RowCount + 1
Next CopyCount

Range(Cells(FirstRow, "F"), Cells(FirstRow, "AC")) = ""
Loop

End Sub