Table transpose

[idnoidno]

transpose.xlsx

Data in the source worksheet, I want to get the target worksheet(There are hundreds of data), I thought for a long time but do not know how to solve it, I hope someone can provide a solution.Any help is very grateful.

[YasserKhalil]

Hello idnoidno
Try this code

Sub Test()
    Dim ws      As Worksheet
    Dim sh      As Worksheet
    Dim a()     As Variant
    Dim rng     As Range
    Dim r       As Range
    Dim c       As Range
    Dim i       As Long
    Dim x       As Long


    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("source")
        Set sh = ThisWorkbook.Worksheets("target")
        
        For Each r In ws.Columns(1).SpecialCells(2).Areas
            Set rng = r.CurrentRegion
    
            For Each c In rng.Columns
                If Application.WorksheetFunction.CountA(c) > 1 And c.Column <> 1 Then
                    x = x + 1
                    ReDim Preserve a(1 To 5, 1 To x)
                    a(1, x) = rng(1)
                    For i = 2 To UBound(a, 1)
                        a(i, x) = rng(c.Column)(i - 1)
                    Next i
                    a(2, x) = CLng(a(2, x))
                End If
            Next c
        Next r
    
        With sh
            With .Cells
                .Clear: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter: .RowHeight = 18
            End With
            .Range("A1").Resize(1, 5).Value = Array("Item", "Date", "L", "W", "H")
            .Range("A1").Resize(1, 5).Font.Bold = True
            .Range("A2").Resize(UBound(a, 2), UBound(a, 1)).Value = Application.Transpose(a)
            .Range("A1").CurrentRegion.Borders.Value = 1
            .Columns(2).NumberFormat = "m/d/yyyy": .Columns(2).ColumnWidth = 13
        End With
    Application.ScreenUpdating = True
End Sub

[idnoidno]

Mr.YasserKhalil ,thank you very much.


I do not understand your CODE, can you take some time to explain, if I can learn your knowledge I will be very grateful.

[YasserKhalil]

You're welcome. Glad I can offer some help for you
As for the code first define the sheets "source" and "target" then loop through areas (separated by empty rows) so as to deal with each table ..and inside that loop the code would count the columns with data except first column and then use the variable x to increase every time the criteria is achieved.
Using an array of 5 rows and then using redim preserve to increase the columns according to the variable x ..filling the array with the desired output
Then some formatting lines

You can press F8 to execute the code line by line and sorry because English is not my native language
May be someone else explain better than me

[idnoidno]

Mr.YasserKhalil ,thank you again.Are you Japanese?
English is not my native language,either.
These codes

For Each r In ws.Columns(1).SpecialCells(2).Areas
Set rng = r.CurrentRegion

For Each c In rng.Columns
If Application.WorksheetFunction.CountA(c) > 1 And c.Column <> 1 Then
x = x + 1 ㄎㄛ
ReDim Preserve a(1 To 5, 1 To x)
a(1, x) = rng(1)
For i = 2 To UBound(a, 1)
a(i, x) = rng(c.Column)(i - 1)
Next i
a(2, x) = CLng(a(2, x))
End If
Next c ext r


I rarely use this way to write code, I use F8 to excute each code but still do not understand，but it is ok,I will google some information to learn.If you can recommend some of the site information, I would be very grateful.

[YasserKhalil]

May be one of the experts volunteer to explain in more professional way
Regards