Transpose multiple rows at once

Mah2017

New Member
Joined
Feb 14, 2018
Messages
5
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
AccountDescriptionCost-CenterJanFebMarAprMayJunJulAugSepOctNovDec
4005Labour423100001000010000100001000010000100001000010000100001000010000
4130Services423100010001000100010001000100010001000100010001000
4280Rent423500500500500500500500500500500500500
4320Material423200200200200200200200200200200200200

<tbody>
</tbody>

I need to transpose data for each tab to Fig 2

Fig 2

AccountCost-CenterPeriodAmount
4005423110000
4005423210000
4005423310000
4005423410000
4005423510000
4005423610000
4005423710000
4005423810000
4005423910000
40054231010000
40054231110000
40054231210000
413042311000
413042321000
413042331000
413042341000
413042351000
413042361000
413042371000
413042381000
413042391000
4130423101000
4130423111000
4130423121000
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
Joined
Apr 11, 2012
Messages
10,306
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
Joined
Dec 3, 2018
Messages
12,622
Office Version
  1. 2007
Platform
  1. Windows
Transpose data for each tab. All tabs in a new sheet or transpose data from each tab in the same tab.
 

Mah2017

New Member
Joined
Feb 14, 2018
Messages
5
thanks for reply

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
Joined
Apr 11, 2012
Messages
10,306
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
Joined
Dec 3, 2018
Messages
12,622
Office Version
  1. 2007
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

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
Top