Excel - A macro to transfer data from rows to columns

Ask a question




Issue

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

Solution

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

Note that

Thanks to rizvisa1 for this tip on the forum.
Jean-François Pillou

CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jeff Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.

Learn more about the CCM team