how to transpose multiple rows to single column
I have a excel sheet as
A 1234
1234
1234
1234
B 12
12
and so on
I need to get a sheet as
A 1234 1234 1234 1234
B 12 12
Solution 1:
Here's a VBA macro to rearrange your data as indicated
It processes the active sheet, and assumes 1) data starts at cell A1, 2) there are no gaps in the rows or columns, 3) there is no other data on the sheet, 4) data consists of values (not formulas), 5) formatting need not be preserved.
Sub OneColumn()
Dim rng As Range
Dim vSrc As Variant
Dim vDst As Variant
Dim cl As Range
Dim ws As Worksheet
Dim rwSrc As Long, rwDst As Long
Dim i As Long
Set ws = ActiveSheet
' find the right most used column
Set cl = ws.UsedRange.Find("*", [A1], xlValues, , xlByColumns, xlPrevious)
' in case there is no data on the sheet
If Not cl Is Nothing Then
' get a range bounding the data
Set rng = Range(ws.[A1], ws.[A1].End(xlDown).Offset(, cl.Column - 1))
' copy source data to an array
vSrc = rng
' size another array large enough (too large) to hold destination data
' (note: vDst is transposed to allow for later redim preserve)
ReDim vDst(1 To 2, 1 To UBound(vSrc, 1) * (UBound(vSrc, 2) - 1))
' loop through the source data, copying to the destination array
rwDst = 1
For rwSrc = 1 To UBound(vSrc, 1)
vDst(1, rwDst) = vSrc(rwSrc, 1)
For i = 2 To UBound(vSrc, 2)
If vSrc(rwSrc, i) <> "" Then
vDst(2, rwDst + i - 2) = vSrc(rwSrc, i)
Else
Exit For
End If
Next
rwDst = rwDst + i - 2
Next
' discard excess size from destination array
ReDim Preserve vDst(1 To 2, 1 To rwDst)
' clear old data from sheet
rng.Clear
' put result on sheet
[A1].Resize(UBound(vDst, 2), 2) = Application.Transpose(vDst)
End If
End Sub