Transpose Rows to Columns but Keeping Data in Blocks

**james_ross** · 01-31-2013, 04:31 AM

Hi,

As the title says but I have shown an example below. I need to be able to do this for 106 sets of data each set containing 18 rows. Therefore the output will be 18 rows and 106 columns.

Thank you very much for you help.

1
2
3
4
5

2
4
6
8
10

3
6
9
12
15

into 

1      2      3
2      4      6
3      6      9
4      8     12
5     10     15

**RHCPgergo** · 01-31-2013, 05:32 AM

Hi,

try running this macro. I assumed that you only have data in column A.

Sub ReorgData()

Dim i As Long
Dim Lr As Long 'last row
Dim Lc As Long 'last column
Dim MyRow As Long 'row to copy to

Lr = Range("A" & Rows.Count).End(xlUp).Row
MyRow = 1
Range("B1").Value = "x"

For i = 1 To Lr
    Lc = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    If Range("A" & i) <> "" Then
        ActiveSheet.Cells(MyRow, Lc).Value = Range("A" & i).Value
        MyRow = MyRow + 1
    Else
        ActiveSheet.Cells(1, Lc + 1).Value = "x"
        MyRow = 1
    End If
Next i

MsgBox "column A not deleted for comparison"

End Sub

**nilem** · 01-31-2013, 05:42 AM

or

Sub ert()
Dim r As Range, i&
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(2).Areas
    i = i + 1: Cells(1, i).Resize(r.Count).Value = r.Value
    If i > 1 Then r.ClearContents
Next r
End Sub