# Transpose rows with repeating headers

#### lets_excel

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

Here's a sample table

A11/1/2022
B21/2/2022
C31/3/2022
D41/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

VBA Code:
``````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!

### Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
VBA Code:
``````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``````

With table from cell A1 to Cn
Result is from cell E2:
VBA Code:
``````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``````

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

Power Query:
``````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
ABCDEF
2A11/1/2022NameA
3B21/2/2022Number1
4C31/3/2022Date1/1/2022
5D41/4/2022NameB
6Number2
7Date1/2/2022
8NameC
9Number3
10Date1/3/2022
11NameD
12Number4
13Date1/4/2022
Sheet1

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. ????

Replies
2
Views
149
Replies
5
Views
313
Replies
3
Views
445
Replies
1
Views
294
Replies
15
Views
248

1,196,497
Messages
6,015,553
Members
441,900
Latest member
Inaschemitex2023

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

### Which adblocker are you using?

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

### Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back