Transpose rows with repeating headers

[lets_excel]

Hello all, looking for help on transposing a row but should keep the headers in the adjacent cell.

Here's a sample table

Name	Number	Date
A	1	1/1/2022
B	2	1/2/2022
C	3	1/3/2022
D	4	1/4/2022

Result should look like this

Name	A
Number	1
Date	1/1/2022
Name	B
Number	2
Date	1/2/2022
Name	C
Number	3
Date	1/3/2022

This code i found somewhere is close but the headers are grouped

Sub Test()

Dim a, b(), i As Long, j As Long, x As Long

a = Range("A1", Cells(4, 1).End(xlToRight))

ReDim b(1 To (UBound(a, 1) - 1) * UBound(a, 2), 1 To 2)

    For i = 1 To UBound(a, 2)
        For j = 2 To UBound(a, 1)
            x = x + 1
            b(x, 1) = a(1, i)
            b(x, 2) = a(j, i)
        Next
    Next
Range("E1").Resize(UBound(b, 1), UBound(b, 2)).Value = b

End Sub

Looking forward to any help. Thanks!

 

[footoo]

Sub Test()
Dim r&, cel As Range, c&
r = Cells(Rows.Count, 1).End(3).Row - 1
Application.ScreenUpdating = False
[A1:D1].Copy
[E1].Resize(4 * r).PasteSpecial Transpose:=True
c = 1
For Each cel In [A2].Resize(r)
    cel.Resize(, 4).Copy
    Cells(Rows.Count, "F").End(3)(c).PasteSpecial Transpose:=True
    c = 3
Next
Application.CutCopyMode = False
End Sub

 

[bebo021999]

With table from cell A1 to Cn
Result is from cell E2:

Option Explicit
Sub Test()
Dim i&, r&
Dim arr(), a
Set a = Range("A1").CurrentRegion
r = (a.Rows.count - 1) * a.Columns.count + a.Rows.count - 2
ReDim arr(1 To r, 1 To 3)
    For i = 1 To r
        Select Case (i - 1) Mod 4
            Case Is = 0
                arr(i, 1) = "Name"
                arr(i, 2) = Cells(Int((i - 1) / 4) + 2, 1)
            Case Is = 1
                arr(i, 1) = "Number"
                arr(i, 2) = Cells(Int((i - 1) / 4) + 2, 2)
            Case Is = 2
                arr(i, 1) = "Date"
                arr(i, 2) = Cells(Int((i - 1) / 4) + 2, 3)
        End Select
        Cells(2, "E").Resize(r, 2).Value = arr ' assum result is from E2
    Next
End Sub

 

[alansidman]

Unpivot your data with Power Query, which is called Get & Transform Data in your version and found on the Data Tab of the Ribbon

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Date", type date}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {}, "Attribute", "Value")
in
    #"Unpivoted Columns"

Book11
	A	B	C	D	E	F
1	Name	Number	Date		Attribute	Value
2	A	1	1/1/2022		Name	A
3	B	2	1/2/2022		Number	1
4	C	3	1/3/2022		Date	1/1/2022
5	D	4	1/4/2022		Name	B
6					Number	2
7					Date	1/2/2022
8					Name	C
9					Number	3
10					Date	1/3/2022
11					Name	D
12					Number	4
13					Date	1/4/2022
Sheet1

 

[lets_excel]

Thank you @footoo @bebo021999 and @alansidman

Tested footoo's and bebo021999's solutions both worked as expected. Thanks!

@alansidman heard of Power Query but have not really used it yet, i guess it's the right time to get into. Your code should come in handy. Thanks!

I really appreciate you guys for taking the time. ????