How about something like:

Option Explicit
Sub testme()
Dim iRow As Long
Dim iCol As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim wks As Worksheet

Set wks = Worksheets("Sheet1")

With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iCol = FirstRow To LastRow
For iRow = iCol + 1 To LastRow
.Cells(iCol, iRow).Value = .Cells(iRow, iCol).Value
Next iRow
Next iCol
End With

End Sub

It just plops the value from cell(x,y) into cell(y,x).



nospaminlich wrote:

The macro below transposes data in a variable sized table on a worksheet so
in this case the macro would add 67, 28 and 37 to the top row, 47 and 89 to
the second row and 58 to the third row.

100
67 100
28 47 100
37 89 58 100

My problem is it doesn't stop when the macro reaches the cell in the bottom
right corner of the range.

You'll see I've tried to use a Do Loop solution which I've placed in various
sections of the code without success.

-------------------------

Sub TranposeData()

Dim lastrow As Long
Dim R As Long, C As Integer
Dim rng As Range

ActiveCell.Offset(1, 1).Activate

Set rng = ActiveCell

lastrow = ActiveCell.End(xlDown).Row + 1
Do Until ActiveCell.Offset(1, 1) = Empty

For R = rng(1).Row To lastrow
C = Cells(R, Columns.Count).End(xlToLeft).Column

Range(Cells(R + 1, C), Cells(lastrow - 1, C)).Copy
Cells(R, C + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:=False, Transpose:=True

Next R
Loop


Application.CutCopyMode = False

End Sub

----------

I'd be grateful for some help on how to make this run correctly.

Thanks a lot

--

Dave Peterson