Public Sub Transpose()
Dim I As Integer
Dim J As Integer
Dim transArray() As Variant
Dim numRows As Integer
Dim numColumns As Integer
Dim colIndex As Integer
Dim rowIndex As Integer
Dim inputRange As Range
Set inputRange = ActiveWindow.Selection
colIndex = inputRange.Column
rowIndex = inputRange.Row
numRows = inputRange.Rows.Count
numColumns = inputRange.Columns.Count
ReDim transArray(numRows - 1, numColumns - 1)
For I = colIndex To numColumns + colIndex - 1
For J = rowIndex To numRows + rowIndex - 1
transArray(J - rowIndex, I - colIndex) = Cells(J, I).Value
Next J
Next I
inputRange.ClearContents
For I = colIndex To numRows + colIndex - 1
For J = rowIndex To numColumns + rowIndex - 1
Cells(J, I).Value = transArray(I - colIndex, J - rowIndex)
Next J
Next I
Cells(rowIndex, colIndex).Select
End Sub