PDA

View Full Version : code Transpose whole workbook



satish gubbi
01-11-2012, 09:50 PM
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
01-12-2012, 02:11 AM
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
01-12-2012, 02:37 AM
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
01-12-2012, 02:44 AM
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
01-12-2012, 03:18 AM
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
01-12-2012, 03:34 AM
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
01-12-2012, 04:02 AM
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
01-12-2012, 04:25 AM
That is what it does.

satish gubbi
01-12-2012, 06:01 AM
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
01-12-2012, 06:49 PM
Please help with my last request

satish gubbi
01-21-2012, 12:45 AM
Hi all,

Please help with my last request

mancubus
01-23-2012, 02:09 AM
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
01-24-2012, 12:06 AM
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
01-24-2012, 06:12 AM
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