Help with Transposing Macro

[unknowndevice]

I want to be able to write this macro so that it will apply to a thousand records along a column. This macro was recorded so that it transposes 9 cells in a column into 9 cells in a row. There is a blank cell between the sets of data in the column.
I need help creating the formula below in this macro that "steps" the copy and paste operation so that it advances down the column in its copy operation and down the rows in its paste operation. Any ideas?


Sub Macro2()
'
' Macro2 Macro
' Macro recorded 8/26/2005 by Joseph Malki
'

'
Range("A1:A9").Select
Selection.Copy
Range("C1:K1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("L3").Select
End Sub

[Dnereb]

That piece of code is.....well not up to any standard.
Try this and try to understand it as well it uses column and row numbers instead of a string reference

Please Login or Register  to view this content.

[RB Smissaert]

This is another way of doing it.
This code presumes the range to transpose is selected first.

Sub TransposeRange()

Dim arr
Dim lCR As Long
Dim lCC As Long

lCR = Selection.Cells(1).Row
lCC = Selection.Cells(1).Column

arr = Selection

Selection.ClearContents

arr = WorksheetFunction.Transpose(arr)

Range(Selection.Cells(1), _
Cells(lCR + UBound(arr) - 1, lCC + UBound(arr, 2) - 1)) = arr

End Sub


RBS

"unknowndevice" <[email protected]>
wrote in message
news:[email protected]...
>
> I want to be able to write this macro so that it will apply to a
> thousand records along a column. This macro was recorded so that it
> transposes 9 cells in a column into 9 cells in a row. There is a blank
> cell between the sets of data in the column.
> I need help creating the formula below in this macro that "steps" the
> copy and paste operation so that it advances down the column in its
> copy operation and down the rows in its paste operation. Any ideas?
>
>
> Sub Macro2()
> '
> ' Macro2 Macro
> ' Macro recorded 8/26/2005 by Joseph Malki
> '
>
> '
> Range("A1:A9").Select
> Selection.Copy
> Range("C1:K1").Select
> Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
> SkipBlanks:= _
> False, Transpose:=True
> Range("L3").Select
> End Sub
>
>
> --
> unknowndevice
> ------------------------------------------------------------------------
> unknowndevice's Profile:
> http://www.excelforum.com/member.php...o&userid=26646
> View this thread: http://www.excelforum.com/showthread...hreadid=399497
>

[unknowndevice]

Dnereb & RB Smissaert:


Dnereb: I dont know how to code. I get an error at this line:

Cells(TargetRow, TargetColumn) = Cells(SourceRow, SourceColumn).Text

What am I supposed to put in any of these fields?


RB Smissaert:

Run time error '9' subscript out of range

Any ideas?

[RB Smissaert]

Did you select the whole range to transpose?
My code was just a simple example. It will need some
error handling, but this shouldn't be too complicated.

RBS

"unknowndevice" <[email protected]>
wrote in message
news:[email protected]...
>
> Dnereb & RB Smissaert:
>
>
> Dnereb: I dont know how to code. I get an error at this line:
>
> Cells(TargetRow, TargetColumn) = Cells(SourceRow, SourceColumn).Text
>
> What am I supposed to put in any of these fields?
>
>
> RB Smissaert:
>
> Run time error '9' subscript out of range
>
> Any ideas?
>
>
> --
> unknowndevice
> ------------------------------------------------------------------------
> unknowndevice's Profile:
> http://www.excelforum.com/member.php...o&userid=26646
> View this thread: http://www.excelforum.com/showthread...hreadid=399497
>

[RB Smissaert]

This should work better:


Sub TransposeRange()

Dim arr
Dim lCR As Long
Dim lCC As Long
Dim UB1 As Long
Dim UB2 As Long

If Selection.Cells.Count = 1 Then
MsgBox "This only works if the range has more than one cell!", , _
"transpose range"
Exit Sub
End If

lCR = Selection.Cells(1).Row
lCC = Selection.Cells(1).Column

arr = Selection

UB1 = UBound(arr)
UB2 = UBound(arr, 2)

Selection.ClearContents

arr = WorksheetFunction.Transpose(arr)

Range(Selection.Cells(1), _
Cells(lCR + UB2 - 1, lCC + UB1 - 1)) = arr

Range(Selection.Cells(1), _
Cells(lCR + UB2 - 1, lCC + UB1 - 1)).Select

End Sub


RBS


"unknowndevice" <[email protected]>
wrote in message
news:[email protected]...
>
> Dnereb & RB Smissaert:
>
>
> Dnereb: I dont know how to code. I get an error at this line:
>
> Cells(TargetRow, TargetColumn) = Cells(SourceRow, SourceColumn).Text
>
> What am I supposed to put in any of these fields?
>
>
> RB Smissaert:
>
> Run time error '9' subscript out of range
>
> Any ideas?
>
>
> --
> unknowndevice
> ------------------------------------------------------------------------
> unknowndevice's Profile:
> http://www.excelforum.com/member.php...o&userid=26646
> View this thread: http://www.excelforum.com/showthread...hreadid=399497
>

[RB Smissaert]

This is a bit neater and the message box doesn't serve any purpose:

Sub TransposeRange()

Dim arr
Dim lCR As Long
Dim lCC As Long
Dim UB1 As Long
Dim UB2 As Long

If Selection.Cells.Count = 1 Then
Exit Sub
End If

lCR = Selection.Cells(1).Row
lCC = Selection.Cells(1).Column

arr = Selection

UB1 = UBound(arr)
UB2 = UBound(arr, 2)

Selection.ClearContents

arr = WorksheetFunction.Transpose(arr)

With Range(Selection.Cells(1), _
Cells(lCR + UB2 - 1, lCC + UB1 - 1))
.Value = arr
.Select
End With

End Sub


RBS


"unknowndevice" <[email protected]>
wrote in message
news:[email protected]...
>
> Dnereb & RB Smissaert:
>
>
> Dnereb: I dont know how to code. I get an error at this line:
>
> Cells(TargetRow, TargetColumn) = Cells(SourceRow, SourceColumn).Text
>
> What am I supposed to put in any of these fields?
>
>
> RB Smissaert:
>
> Run time error '9' subscript out of range
>
> Any ideas?
>
>
> --
> unknowndevice
> ------------------------------------------------------------------------
> unknowndevice's Profile:
> http://www.excelforum.com/member.php...o&userid=26646
> View this thread: http://www.excelforum.com/showthread...hreadid=399497
>