macro to transpose a table into column

i have numbers are arrange in table like in first row 1 to 10 then in next row 11 to 20 then 21 to 30 and so on i want that each row should transpose into single column like in any column 1 to 10 then below 10, 11 to 20, then 21 to 30 and so on

2 answers

  • answered 2019-04-21 05:27 Skin

    Add the below code to a new module in the VBA editor ...

    Public Sub TransformDataToColumns()
        Dim rngCells As Range, objCell As Range, lngWriteRow As Long
        Dim objDestSheet As Worksheet
    
        Set rngCells = Selection
        Set objDestSheet = Sheets("Transformed")
    
        objDestSheet.Cells.Clear
    
        For Each objCell In rngCells
            lngWriteRow = lngWriteRow + 1
            objDestSheet.Cells(lngWriteRow, 1) = objCell.Value
        Next
    
        objDestSheet.Activate
    End Sub
    

    ... add a new worksheet into your workbook called Transformed

    Now select your table of data (as shown below) and run the macro. All things held constant, it should work for you.

    enter image description here

  • answered 2019-04-21 07:09 YasserKhalil

    Try this code

    Sub Test()
    Dim r1          As Range
    Dim r2          As Range
    
    With Sheets("Sheet1")
        Set r1 = .Range("A1:D" & .Columns("A:D").Find("*", [A1], , , 1, 2).Row)
        Set r2 = .Range("K1")
        MultipleColumnsIntoOne r1, r2
    End With
    End Sub
    
    Sub MultipleColumnsIntoOne(rSource As Range, rDest As Range)
    Dim a           As Variant
    Dim b           As Variant
    Dim i           As Long
    Dim j           As Long
    Dim k           As Long
    
    a = rSource.Value
    ReDim b(1 To UBound(a, 1) * rSource.Columns.Count)
    
    For j = LBound(a, 2) To UBound(a, 2)
        For i = LBound(a, 1) To UBound(a, 1)
            If Not IsEmpty(a(i, j)) Then
                k = k + 1
                b(k) = a(i, j)
            End If
        Next i
    Next j
    
    rDest.Resize(k).Value = Application.Transpose(b)
    End Sub