# Transpose multiple rows at once

#### Mah2017

##### New Member
Hi.
Twice a year i have a task that i hope can be simplified. I'll just show the input and show how it should look at the end

My working budget file has about 40 tabs (each tab represents a different Cost Center).
Each tab if formatted exactly the same way (fig 1)
Each cost center has 117 accounts
My goal is to highlight data in Fig 1 ie (A9:O126)

Fig 1
 Account Description Cost-Center Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 4005 Labour 423 10000 10000 10000 10000 10000 10000 10000 10000 10000 10000 10000 10000 4130 Services 423 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 4280 Rent 423 500 500 500 500 500 500 500 500 500 500 500 500 4320 Material 423 200 200 200 200 200 200 200 200 200 200 200 200

<tbody>
</tbody>

I need to transpose data for each tab to Fig 2

Fig 2

 Account Cost-Center Period Amount 4005 423 1 10000 4005 423 2 10000 4005 423 3 10000 4005 423 4 10000 4005 423 5 10000 4005 423 6 10000 4005 423 7 10000 4005 423 8 10000 4005 423 9 10000 4005 423 10 10000 4005 423 11 10000 4005 423 12 10000 4130 423 1 1000 4130 423 2 1000 4130 423 3 1000 4130 423 4 1000 4130 423 5 1000 4130 423 6 1000 4130 423 7 1000 4130 423 8 1000 4130 423 9 1000 4130 423 10 1000 4130 423 11 1000 4130 423 12 1000 etc

<tbody>
</tbody>

### Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

#### mumps

##### Well-known Member
Do you want to do this for all 40 sheets? Where do you want figure 2 for each sheet to appear?

#### DanteAmor

##### Well-known Member
Transpose data for each tab. All tabs in a new sheet or transpose data from each tab in the same tab.

#### Mah2017

##### New Member

Yes the goal would be to do all 40 sheets

In the end Figure 2 needs to be on one new sheet.

#### mumps

##### Well-known Member
Create a sheet and name it "Summary". Try this amcro:
Code:
``````Sub transposeRows()
Application.ScreenUpdating = False
Dim LastRow As Long, ws As Worksheet, account As Range, desWS As Worksheet
Set desWS = Sheets("Summary")
For Each ws In Sheets
If ws.Name <> "Summary" Then
LastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For Each account In ws.Range("A2:A" & LastRow)
With desWS
.Cells(desWS.Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(12, 1) = account
.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0).Resize(12, 1) = account.Offset(0, 2)
End With
With desWS.Cells(desWS.Rows.Count, "C").End(xlUp).Offset(1, 0)
.Value = 1
.AutoFill Destination:=desWS.Cells(desWS.Rows.Count, "C").End(xlUp).Resize(12, 1), Type:=xlFillSeries
End With
account.Offset(0, 3).Resize(1, 12).Copy
desWS.Cells(desWS.Rows.Count, "D").End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next account
End If
Next ws
Application.ScreenUpdating = True
End Sub``````

Last edited:

#### DanteAmor

##### Well-known Member
Create a sheet called "Center"

Try this:

Code:
``````Sub Transponer_Costos()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim n As Double, i As Double, u2 As Double
'
Set ws1 = Sheets("Center")
ws1.Rows("2:" & Rows.Count).ClearContents
n = 2
For Each ws2 In Sheets
Select Case ws2.Name
'Name of sheets excluded
Case ws1.Name, "sheet1", "Sheet5"

Case Else
u2 = ws2.Range("D" & Rows.Count).End(xlUp).Row
For i = 9 To u2
ws1.Range("A" & n).Resize(12).Value = ws2.Cells(i, "A").Value
ws1.Range("B" & n).Resize(12).Value = ws2.Cells(i, "C").Value
ws1.Range("C" & n).Resize(12).Value = WorksheetFunction.Transpose(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12))
ws1.Range("D" & n).Resize(12).Value = WorksheetFunction.Transpose(ws2.Range("D" & i & ":O" & i).Value)
n = n + 12
Next
End Select
Next
MsgBox "End"
End Sub``````

Replies
5
Views
64
Replies
34
Views
508
Replies
6
Views
560
Replies
1
Views
120
Replies
2
Views
733

1,129,816
Messages
5,638,496
Members
417,029
Latest member
lingx86

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

### Which adblocker are you using?

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

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