PDA

View Full Version : Transpose data into Rows



vikash200418
04-10-2012, 03:11 PM
Hi Admin,

Sorry to post my requirement in this thread as I am very new to this forum and still to find the way to post a new thread.

I am using MS office 2007, windows XP professional

I am in urgent need of a macro. the requirements are as follows:

Copies different columns (a msg box to ask how many columns to copy) and paste under one column in a destination (input box to ask for the destination) for pasting the copied data.

I tried using clipboard and recording a macro but this does not seem to work perfectly

Column1 Column2 Column3 Column4
A B C D
A B C D
A B C D
A B C D
A B C D


Solution should look like:
New Column
A
A
A
A
A
B
B
B
B
B
C
C
C
C
C
D
D
D
D
D


I have tried this macro but this is not fullfiling my requirements


Sub Macro1()
'
' Macro1 Macro
'
'
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ActiveCell.Offset(0, 1).Range("A1").Select
End Sub

Hope, I get the solution to my problem.

Thank you so much in advance.

Thanks,
Vikash

Admin
04-10-2012, 03:41 PM
Hi Vikash,

Welcome to board !

Please post questions in appropriate forum. This time I have moved the post for you. In future care to post in appropriate forum. Also use code tags while posting codes. :)

Rick Rothstein
04-10-2012, 11:02 PM
You asked this same question in the MrExcel forum where I gave you this macro to do what you want...


Sub RepeatCopyRectangularRange()
Dim X As Long, Z As Long, RowCount As Long, ColCount As Long
Dim ColRng As Variant, SourceStartCell As Range, Destination As Range
Set SourceStartCell = Selection(1)
RowCount = Selection.Rows.Count
ColCount = Selection.Columns.Count
On Error GoTo NoDestination
Set Destination = Application.InputBox("Select the starting cell on the destination sheet.", Type:=8)
On Error GoTo 0
If Not Destination Is Nothing Then
For X = 1 To ColCount
ColRng = Cells(SourceStartCell.Row, SourceStartCell.Column + X - 1).Resize(RowCount)
Destination.Offset(RowCount * (X - 1)).Resize(RowCount) = ColRng
Next
End If
NoDestination:
End Sub