View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
T-容x[_42_] T-容x[_42_] is offline
external usenet poster
 
Posts: 1
Default Write Data from Sheet1 to sheet2 Until


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-容x
------------------------------------------------------------------------
T-容x's Profile: http://www.excelforum.com/member.php...o&userid=26572
View this thread: http://www.excelforum.com/showthread...hreadid=399965