Transpose Rows to a single a Column one below other

  • Thread starter Thread starter Rashid Khan
  • Start date Start date
R

Rashid Khan

Hello All,
I am using Office XP and have the following problem.
My data is in the following format:

A B C D E F G H I J.....
1 2 3 4 5 6 7 8 9 10....
11 12 13 14 15 16 17 18 19 20
.....
.....
....
51 52 53 54 55 56 57 58 59 60
.....

I wish to have the data in rows to be transposed on Sheet2, Col A as
follows:
A B C
1
2
3
4
5
6
7
8
9
10
<blank row>
11
12
13
14
15
16
17
18
19
20
<blank row>
.....
.....
I have checked using Copy/Paste Special/Transpose but the result come side
by side. My requirement is to have it in a single Col A on Sheet 2.

Can this be achieved. I can make the selection prior to running the macro.

Thanks to all in advance

Rashid
 
Hi Rashid,

Here's some code

Sub Reorganise()
Dim cCols As Long
Dim cRows As Long
Dim i As Long
Dim j As Long


With Selection
cRows = .Rows.Count + .Row - 1
cCols = .Columns.Count + .Column - 1
For i = cRows To .Row Step -1
For j = .Column + 1 To cCols
Cells(i + j - .Column, .Column).Value = Cells(i, j).Value
Next j
Cells(i, .Column + 1).Resize(1, cCols - .Column).ClearContents
If i <> .Row Then
Cells(i, .Column).Resize(cCols - .Column + 1,
1).EntireRow.Insert
End If
Next i
End With

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob,
Thanks for the Code. It works fine... But I want it to copy the matter on
Sheet2. Your code work on Sheet1. Could u pls amend it for copying it on
Sheet2.

Thanks for your time and help
Rashid Khan
 
Sub Reorganise()
Dim cCols As Long
Dim cRows As Long
Dim i As Long
Dim j As Long
Dim oTarget As Worksheet

Set oTarget = Worksheets("Sheet2")
With Selection
cRows = .Rows.Count + .Row - 1
cCols = .Columns.Count + .Column - 1
For i = cRows To .Row Step -1
For j = 1 To cCols
oTarget.Cells((i - 1) * 11 + j, 1).Value = Cells(i, j).Value
Next j
Next i
End With

End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob,
Thanks for the quick response. But this macro copies the Column with '3
Blank Rows' in between.. The previous one used to insert on a Single Blank
Row in between.. Something is missing ?

Thanks for your time and help
Rashid
 
I only get one?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
It would seem so Rashid, but no bright ideas as to what.

Try sending me your workbook, and I will look at it.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Bob,
I have mailed you the Sample Worksheet. Pls have a look on your email
(e-mail address removed).
Many thanks for your time and help
Rashid Khan
 
Rashid,

Haven't received it yet! Right email address.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Sent it again today.
Rashid
Bob Phillips said:
Rashid,

Haven't received it yet! Right email address.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
Click to expand...
 
Back
Top