Hi
I have a workbook with several worksheets, I need a macro which transpose the data in it from rows to column
Please help
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]
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
Attached is the file that I am working now to transpose rows to columnOriginally Posted by xld
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]
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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.
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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...
PLS DO NOT PM; OPEN A THREAD INSTEAD!!!
1) Posting Code
[CODE]PasteYourCodeHere[/CODE]
(or paste your code, select it, click # button)
2) Uploading File(s)
Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.
3) Testing the Codes
always back up your files before testing the codes.
4) Marking the Thread as Solved
from Thread Tools (on the top right corner, above the first 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]
PLS DO NOT PM; OPEN A THREAD INSTEAD!!!
1) Posting Code
[CODE]PasteYourCodeHere[/CODE]
(or paste your code, select it, click # button)
2) Uploading File(s)
Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.
3) Testing the Codes
always back up your files before testing the codes.
4) Marking the Thread as Solved
from Thread Tools (on the top right corner, above the first message)