If you're planning to use the code in other situations, I must warn yo
that it is not very neat as it only exchanges the values of the row an
column numbers to acheive transposition...

Haven't really tested the code well... So maybe you can try it and tel
me what it can and cannot do... ;)

As you can see in the code, TransposeTo accepts a Range and
WorkSheet.
Range is the [Cell] you are transposing. WorkSheet is the destinatio
sheet.

Please also note the IsColumnEmpty function... I didn't use it!!
hahaha.... But, I think it works...

(I'm not really making any sense here... Just try the code... :) )

PY & Associates Wrote:
T-®ex

You are much cleverer than I am in guessing user's mind.
One curiosity, in what way we can make use of this transpose please?

"T-®ex" wrote:


Hi Maperalia! Try the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
TransposeTo Target, Sheet2
End Sub

Sub TransposeTo(ByVal Target As Range, ByVal DestSheet As Worksheet)
If Target.Worksheet.CodeName < DestSheet.CodeName Then
DestSheet.Cells(Target.Column,
NextColumn(DestSheet.Cells(Target.Column, Target.Row))).Value =
Target.Value
End If
End Sub

'returns the column number of the first empty column to the right of
Target
Function NextColumn(ByVal Target As Range) As Integer
Dim ColNum As Integer
ColNum = Target.Column

Dim NextCol As Range
Set NextCol = Target

While Not IsEmpty(NextCol.Value)
Set NextCol = NextCol.Offset(0, 1)
Wend

NextColumn = NextCol.Column
End Function

'determines whether a column (TargetCol) is empty
Function IsColumnEmpty(ByVal TargetCol As Range) As Boolean
Dim EntireCol As Range 'just making sure we really do have the
entire column
Set EntireCol = TargetCol.EntireColumn

Dim ColEmpty As Boolean
ColEmpty = True

If Not IsEmpty(TargetCol.Item(1)) Then
ColEmpty = False
ElseIf Not IsEmpty(EntireCol.Rows.Item(EntireCol.Rows.Count)) Then
ColEmpty = False
Else
Dim LastCell As Range
Set LastCell = EntireCol.End(xlDown)

If LastCell.Row < 65536 Then
ColEmpty = False
End If
End If

IsColumnEmpty = ColEmpty
End Function

I'm assuming you're still using Sheet1 as input sheet and Sheet2 as
result sheet.
In this case, put the code above in Sheet1. (The code is not very
elegant... sorry...)


--
T-®ex

------------------------------------------------------------------------
T-®ex's Profile
http://www.excelforum.com/member.php...o&userid=26572
View this thread
http://www.excelforum.com/showthread...hreadid=399965



--
T-®e
-----------------------------------------------------------------------
T-®ex's Profile: http://www.excelforum.com/member.php...fo&userid=2657
View this thread: http://www.excelforum.com/showthread.php?threadid=39996