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

xor · #4 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.

LearnerExcel · #5 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.

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

Best wishes !

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