Transpose Question

[clollar]

New to this forum, and am looking for a little help. I have some data I
am looking to transpose, and need some suggestions on how to do this
more quickly. My data set is a daily data set that is organized into
rows. There are 11 values for the first two rows, and anywhere from 6
to 9 values in the 3rd row. I need these three rows transposed into
one column, and then the process is repeated for 11 more sets of 3
rows, all transposed into the same column. The next 12 sets of 3 rows
would go in column 2, followed by the next 12 sets of 3 rows going into
column 3, and so on.

To clarify what the data is, it is daily values, with January 1-11 in
row 1, 12-22 in row 2, and 23-31 in row 3, followed by February with
the next set of 3 rows, March with the next set, etc... I realize I
could take each row, copy, then paste special, and chose transpose, but
considering the number of years this set involves (from 1896-present),
there has to be an easier way. Can anyone help with a script? Any
help is much appreciated.

 

[Guest]

Sub Transpose()
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim i As Long, j As Long
Dim i1 As Long, lastrow As Long
Set sh = ActiveSheet
i = 1
j = 1
i1 = 1
Set sh1 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
Do While i <= lastrow
If Not IsEmpty(sh.Cells(i, j)) Then
sh1.Cells(i1, 1) = sh.Cells(i, j).Value
i1 = i1 + 1
j = j + 1
Else
i = i + 1
j = 1
End If
Loop
End Sub

 

[clollar]

Tom,

Thanks a ton for the quick response. This worked to take all rows and
combine into one column. Is there an easy way to take x number of rows
and combine into column 1, followed by x number of rows (same value of
x) and combine into column 2, and so on using a script? In this case,
I am talking about 36 rows = 1 column. So the first 36 rows would go
in column 1, the next 36 rows (37-72) would go in column 2, and so on.

Again, thanks again for your quick response.

 

[Guest]

Sub Transpose1()
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim i As Long, j As Long
Dim i1 As Long, lastrow As Long
Dim j1 As Long
Set sh = ActiveSheet
i = 1
j = 1
i1 = 1
j1 = 1
Set sh1 = Worksheets.Add(After:=Worksheets(Worksheets.Count))
lastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
Do While i <= lastrow
If Not IsEmpty(sh.Cells(i, j)) Then
sh1.Cells(i1, j1) = sh.Cells(i, j).Value
i1 = i1 + 1
j = j + 1
Else
i = i + 1
If i Mod 36 = 1 Then
j1 = j1 + 1
i1 = 1
End If
j = 1
End If
Loop
End Sub

 

[clollar]

Tom, you are a godsend! Thanks a ton! :