Previous Topic Next Topic

How to move data in rows to columns

Solved/Closed
-
 Ema -
The data now is in the below format

1 2 3
9 15 16 20 25
1

This has to come in this format

1
2
3
9
15
16
20
25
1



1 reply

Answer 1 / 1
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
 769
Assumptions
1. Data starts from Row 1 and is to be always copied to column A
2. Rows can be inserted without distortion to data 
Sub TransposeSpecial()
Dim lMaxRows As Long 'max rows in the sheet
Dim lThisRow As Long 'row being processed
Dim iMaxCol As Integer 'max used column in the row being processed

    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    
    lThisRow = 1 'start from row 1
    
    Do While lThisRow < lMaxRows
        
        iMaxCol = Cells(lThisRow, Columns.Count).End(xlToLeft).Column
        
        If (iMaxCol > 1) Then
            Rows(lThisRow + 1 & ":" & lThisRow + iMaxCol - 1).Insert
            Range(Cells(lThisRow, 2), Cells(lThisRow, iMaxCol)).Copy
            Range("A" & lThisRow + 1).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Range(Cells(lThisRow, 2), Cells(lThisRow, iMaxCol)).Clear
            lThisRow = lThisRow + iMaxCol - 1
            lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
        End If
        
        lThisRow = lThisRow + 1
    Loop
End Sub

Thank you very much! Your program helped me a lot.
Ask a question