code Transpose whole workbook

[satish gubbi]

Hi

I have a workbook with several worksheets, I need a macro which transpose the data in it from rows to column

Please help

[Bob Phillips]

Dim sh As Worksheet
Dim here As Range
Dim rng As Range

Set here = Selection
For Each sh In ActiveWorkbook.Worksheets

Set rng = sh.UsedRange
rng.Copy
rng.Offset(0, rng.Columns.Count).Cells(1, 1).PasteSpecial Paste:=xlPasteAll, transpose:=True
rng.EntireColumn.Delete
Next sh

here.Select
Application.CutCopyMode = False

[satish gubbi]

Hi Xld,

thank you very much replying however, I am getting a "run time error 1004" when i hit debug the below code is getting highlighted

rng.Offset(0, rng.Columns.Count).Cells(1, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True

Request your help,

[Bob Phillips]

It worked in my test data, so there must be something with your data I haven't anticipated. Without seeing it, I cannot say what that might be.

[satish gubbi]

It worked in my test data, so there must be something with your data I haven't anticipated. Without seeing it, I cannot say what that might be.

Attached is the file that I am working now to transpose rows to column

Request your help

and this code should run for all the worksheets in the workbook

[Bob Phillips]

Try this version




Dim sh As Worksheet
Dim here As Range
Dim rng As Range

Set here = Selection
For Each sh In ActiveWorkbook.Worksheets

Set rng = sh.UsedRange
Set rng = rng.Cells(1, 1).Resize(rng.Rows.Count, _
Cells(rng.Rows(1).Row, sh.Columns.Count).End(xlToLeft).Column)
rng.Copy
rng.Cells(1, 1).Offset(0, rng.Columns.Count).PasteSpecial Paste:=xlPasteAll, Transpose:=True
rng.EntireColumn.Delete
Next sh

here.Select
Application.CutCopyMode = False

[satish gubbi]

Hi,
Thank you very much for the code however I require slight changes in the code.

I need code to run as required in the attachment

example workbook has to two tabs "Raw data" and "needs to be after macro" (I have manually copied & Transposed)

once code is executed, it should create data as in "needs to be after macro" tab.

your help in this regard is highly appreciated.

[Bob Phillips]

That is what it does.

[satish gubbi]

Hi,

This code is working with first page properly, but not with other sheets in workbook.

request you to rectify the same, your help in this is highly appreciated.

regards,
Satish Gubbi

[satish gubbi]

Please help with my last request

[satish gubbi]

Hi all,

Please help with my last request

[mancubus]

in worksheets there are selected ranges...


try with a copy...


Sub TransposeRange()
'http://www.vbaexpress.com/forum/showthread.php?t=40477

Dim ws As Worksheet
Dim rng As Range
Dim LastRow As Long, LastCol As Long

For Each ws In ActiveWorkbook.Worksheets
With ws
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set rng = Range(.Cells(1, 1), .Cells(LastRow, LastCol))
rng.Copy
rng.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
rng.EntireColumn.Delete
.Cells(1, 1).Select
End With
Next ws
Application.CutCopyMode = False

End Sub





PS: pls do not send private messages. in order to bump your thread, just post a new message...

[satish gubbi]

Hi Mancubus,

thanks for your help in this regard, however this code, worked for first two tabs correctly the showing error

request your help

[mancubus]

wellcome.

you'd better state the error it throws otherwise i have to predict...

btw, it throws "rte 1004: Select method of Range class failed."


Sub TransposeRange()
'http://www.vbaexpress.com/forum/showthread.php?t=40477

Dim ws As Worksheet
Dim rng As Range
Dim LastRow As Long, LastCol As Long

For Each ws In ActiveWorkbook.Worksheets
With ws
.Activate
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set rng = Range(.Cells(1, 1), .Cells(LastRow, LastCol))
rng.Copy
rng.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
rng.EntireColumn.Delete
.Range("A1").Select
End With
Next ws

Application.CutCopyMode = False

End Sub


or


Sub TransposeRange()
'http://www.vbaexpress.com/forum/showthread.php?t=40477

Dim ws As Worksheet
Dim rng As Range
Dim LastRow As Long, LastCol As Long

For Each ws In ActiveWorkbook.Worksheets
With ws
LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
LastCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set rng = Range(.Cells(1, 1), .Cells(LastRow, LastCol))
rng.Copy
rng.Cells(1, LastCol + 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
rng.EntireColumn.Delete
End With
Next ws
Application.CutCopyMode = False

End Sub