Need function that transpose the rows data of a table automatically.

LearnerExcel · #1 07-07-2023, 03:31 PM

Hi,

I have the excel file with a table that contains 700 rows. Now, I need that data to be copied like shown in the picture. Manually copy data by using transpose is a very lengthy process and it needs to be completed urgently.

How to resolve this problem. Please support me.

Best regards.

Alansidman · #2 07-07-2023, 06:55 PM

With Power Query

Code:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(Source, {}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Columns",{"Attribute"})
in
    #"Removed Columns"

Logit · #3 07-07-2023, 07:07 PM

Code:

Option Explicit

Sub MoveToASingleColumn()


    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim arr()   As Variant
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
    Dim x   As Long
    Dim y   As Long
    Dim i   As Long
    
    x = ws1.Range("A" & Rows.Count).End(xlUp).Row
    y = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    arr = Cells(1, 1).Resize(x, y).Value
    
    i = 1
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = LBound(arr, 2) To UBound(arr, 2)
            If Len(arr(x, y)) <> 0 Then
                ws2.Cells(i, 1).Value = arr(x, y)
                i = i + 1
            End If
        Next y
    Next x
    
    Erase arr
    
    Set ws1 = Nothing
    Set ws2 = Nothing
    
End Sub

LearnerExcel · #4 07-08-2023, 08:55 AM

Quote:

Originally Posted by Logit

Code:

Option Explicit

Sub MoveToASingleColumn()


    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim arr()   As Variant
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    
    Dim x   As Long
    Dim y   As Long
    Dim i   As Long
    
    x = ws1.Range("A" & Rows.Count).End(xlUp).Row
    y = ws1.Cells(1, Columns.Count).End(xlToLeft).Column
    
    arr = Cells(1, 1).Resize(x, y).Value
    
    i = 1
    For x = LBound(arr, 1) To UBound(arr, 1)
        For y = LBound(arr, 2) To UBound(arr, 2)
            If Len(arr(x, y)) <> 0 Then
                ws2.Cells(i, 1).Value = arr(x, y)
                i = i + 1
            End If
        Next y
    Next x
    
    Erase arr
    
    Set ws1 = Nothing
    Set ws2 = Nothing
    
End Sub

Thanks a million for your kind support. It is work great for me.

Best regards.

xor · #5 07-08-2023, 04:24 AM

If your table is named Table1 then:

=INDEX(Table1,INT((ROW(1:1)-1)/4)+1,MOD((ROW(1:1)-1),4)+1)

Copy down.

Logit · #6 07-08-2023, 09:05 AM

Best wishes !

Thread Tools
Show Printable Version Email this Page
Display Modes
Switch to Linear Mode Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Drop Down List to Automatically Populate Data in a Table	src144	Word VBA	8	12-03-2020 04:15 PM
Transpose data form columns in rows matched with a key	Alex1s85	Excel	7	11-26-2020 01:34 AM
Transpose multiple data form rows in columns matched with a key	Alex1s85	Excel	6	06-24-2020 07:08 AM
need VBA to Transpose the Data from excel to word based on given criteria(status)	winmaxservices2	Excel Programming	1	12-19-2014 10:21 PM
Data table search function	omtinole	Excel Programming	1	07-13-2012 10:03 PM