|
Public Sub DynamicTranspose()
Dim I As Integer
Dim J As Integer
Dim transArray() As Integer
Dim numRows As Integer
Dim numColumns As Integer
Do
numRows = I
I = I + 1
Loop Until Cells(I, "A").Value = ""
I = 0
Do
numColumns = I
I = I + 1
Loop Until Cells(1, Chr(I + 64)).Value = ""
ReDim transArray(numRows - 1, numColumns - 1)
'
For I = 1 To numColumns
For J = 1 To numRows
transArray(J - 1, I - 1) = Cells(J, Chr(I + 64)).Value
Next J
Next I
'
Range("A1:C10").ClearContents
'
For I = 1 To numColumns
For J = 1 To numRows
Cells(I, Chr(J + 64)).Value = transArray(J - 1, I - 1)
Next J
Next I
End Sub
|