I don't think this is exactly right. It don't know if you want any formulas
put into the worksheet to automatically sum columns and I don't know which
columns the zeroes in the input match the zeroes in the output. the code
copies the data from sheet 1 to sheet 2. change as required.

Sub ColumnsToRows()

Set SourceSht = Sheets("Sheet1")
Set DestSht = Sheets("Sheet2")

NewRow = 1
With SourceSht
RowCount = 1
ItemNum = 1
Do While .Range("A" & RowCount) < ""
Col_B = .Range("B" & RowCount)
Col_C = .Range("C" & RowCount)
Col_D = .Range("D" & RowCount)
Col_E = .Range("E" & RowCount)
With DestSht
.Range("A" & NewRow & ":A" & (NewRow + 6)) = ItemNum
.Range("B" & NewRow) = Col_B
.Range("B" & (NewRow + 1)) = Col_C
.Range("B" & (NewRow + 2)) = Col_D
.Range("B" & (NewRow + 3)) = Col_E
.Range("B" & (NewRow + 4)) = Col_C
.Range("B" & (NewRow + 5)) = Col_B

NewRow = NewRow + 6
End With
ItemNum = ItemNum + 1
RowCount = RowCount + 1
Loop
End With
End Sub



"Charles" wrote:

I need to transpose a grid of data into a linear format, a cut of the
existing data looks like this:

B C D E
1 35714.57 0 0 34365.98
2 23874.54 0 23843.06 22860.84
3 44657.62 0 0 42872.15
4 33940.83 0 0 33940.83
5 52097.52 0 0 50002.48
6 32843.55 0 0 32843.55
7 36063.75 0 0 36063.75
8 35093.81 0 0 35093.81
9 10873.63 0 0 10873.63
And I want it to look like this:

1 35714.57
1 0
1 0
1 34365.98
1 0
1 35714.57
2 23874.54
2 0
2 23843.06
2 22860.84
2 0
2 23874.54

The existing data extend to 20 or more columns and there will be 9000 rows.

Any suggestions gratefully received.

Thanks