Try this:

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



Maperalia