Hi

Why not use Transpose.

Select the table, and copy it, select destination cell, goto Insert
PasteSpecial Transpose OK

Regards,
Per

On 18 Mar., 01:25, Greg Snidow
wrote:
Greetings all. *I have a frequent need to simply pivot a table, and that's
it. *I end up using the pivot table wizard, and then trying to copy and paste
the values I need, and it is a time consuming process. *All I really need is
to simply pivot it, turning the rows into columns, and visa versa. *I made a
simple macro to do the task, but in the interest of learning something new, I
would like to see if anyone else has a better way. *Take any table of data,
and highlight the cell between the row header and column header, and run it. *
It will produce a pivoted version of the table under the original table. *So,
for example, if your table column header is in row 1, and your row labels are
in column A, you would want to select A1, and run the macro. *Any ideas on a
better way? *Any reason why I should not use this? *Thanks in advance, if
anyone is so inclined to give some feedback.

Sub Pivot()

* * Dim StartCell As Variant
* * Dim StartCellOld As Variant
* * Dim r As Integer 'will hold number of rows in the table
* * Dim rOld As Integer
* * Dim c As Integer 'will hold number of columns in the table
* * Dim i As Integer

* * 'Pick a starting point as reference to be used later
* * StartCell = ActiveCell.Address
* * StartCellOld = StartCell 'save this to return to the starting point

* * 'Start by counting the rows
* * r = 0
* * Range(StartCell).Offset(1, 0).Activate
* * Do While ActiveCell.Value < ""
* * * * ActiveCell.Offset(1, 0).Activate
* * * * r = r + 1
* * Loop

* * 'Then count the columns
* * Range(StartCell).Activate
* * Range(StartCell).Offset(0, 1).Activate

* * c = 0

* * Do While ActiveCell.Value < ""
* * * * ActiveCell.Offset(0, 1).Activate
* * * * c = c + 1
* * Loop

* * Range(StartCell).Activate

* * 'Populate the new row labels
* * Range(StartCell).Offset(r + 4, 0).Activate
* * i = 1
* * Do While c = 0
* * * * ActiveCell.Value = Range(StartCell).Offset(0, i).Value
* * * * c = c - 1
* * * * i = i + 1
* * * * ActiveCell.Offset(1, 0).Activate
* * Loop
* * 'Then populate the column headers and data
* * Range(StartCell).Offset(r + 3, 1).Activate
* * i = 1
* * rOld = r

* * Do Until Range(StartCell).Offset(r, 0) = ""
* * * * Do Until r = 0
* * * * * * ActiveCell.Value = Range(StartCell).Offset(i, 0).Value
* * * * * * r = r - 1
* * * * * * i = i + 1
* * * * * * ActiveCell.Offset(0, 1).Activate
* * * * Loop
* * StartCell = Range(StartCell).Offset(0, 1).Address
* * r = rOld
* * i = 1
* * * * ActiveCell.Offset(1, -r).Activate
* * * * ActiveCell.Value = Range(StartCell).Offset(i, 0).Value
* * Loop

* * Range(StartCellOld).Offset(r + 3, 0).Activate

End Sub