code Transpose whole workbook

Hi

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

Please help

[vba]

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
[/vba]

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,

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.

Quote:

---

Originally Posted by xld

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

Try this version

[vba]


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
[/vba]

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.

That is what it does.

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

Please help with my last request

Hi all,

Please help with my last request

in worksheets there are selected ranges...


try with a copy...

[VBA]
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
[/VBA]




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

Hi Mancubus,

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

request your help

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

[vba]
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
[/vba]

or

[vba]
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
[/vba]