Transpose Rows to a single a Column one below other

[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

 

[Bob Phillips]

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)

 

[Rashid Khan]

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

 

[Bob Phillips]

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)

 

[Rashid Khan]

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

 

[Bob Phillips]

I only get one?

--

HTH

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

 

[Rashid Khan]

Hi Bob,
I still that three. Am I doning something wrong?
Rashid Khan

 

[Bob Phillips]

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)

 

[Rashid Khan]

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

 

[Bob Phillips]

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)

 

[Rashid Khan]

Sent it again today.
Rashid

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)

 

[Bob Phillips]

Got it, correction posted.

Bob

Sent it again today.
Rashid

 

[Rashid Khan]

Hi Bob,
Works like a magic wand. Thanks a lot.
Rashid Khan