Thread
:
Write Data from Sheet1 to sheet2 Until
View Single Post
#
19
Posted to microsoft.public.excel.programming
T-容x[_50_]
external usenet poster
Posts: 1
Write Data from Sheet1 to sheet2 Until
Hi Maperalia!
sorry you can't download the attachment... :( dunno why...
if you like you can give me your email and i'll send the attachment to
you...
if you don't want to "advertise"
your email, then you can email
me at
. just make sure i'll know it's from you...
then i'll send you the file...
Anywayz... you can still try the following:
(The codes below are a small part from the file attached
previously...)
In Sheet1, add the ff code (Be sure you also have Sheet2):
Code:
--------------------
Option Explicit
Dim LastRowVal As Long
Dim LastColVal As Integer
Private Sub Worksheet_Activate()
LastRowVal = 1 'Start at Row 1
LastColVal = 1 'Start at Column A
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'Comment one line and uncomment the other line and see the difference between the two subs
ColumnToRow Target, Sheet2
' RowToColumn Target, Sheet2
End Sub
Sub ColumnToRow(ByVal Target As Range, ByVal DestSheet As Worksheet)
Dim SRow As Long
SRow = NextRow(DestSheet.Cells(Target.Column, Target.Row))
If SRow < LastRowVal Then
SRow = LastRowVal
End If
LastRowVal = SRow
If Target.Worksheet.CodeName < DestSheet.CodeName Then
DestSheet.Cells(SRow, Target.Row) = Target.Value
End If
End Sub
Sub RowToColumn(ByVal Target As Range, ByVal DestSheet As Worksheet)
Dim SCol As Long
SCol = NextColumn(DestSheet.Cells(Target.Column, Target.Row))
If SCol < LastColVal Then
SCol = LastColVal
End If
LastColVal = SCol
If Target.Worksheet.CodeName < DestSheet.CodeName Then
DestSheet.Cells(Target.Column, SCol) = Target.Value
End If
End Sub
'returns the column number of the first empty cell to the right of Target
Function NextColumn(ByVal Target As Range) As Integer
Dim NextCol As Range
Set NextCol = Target
While Not IsEmpty(NextCol.Value)
Set NextCol = NextCol.Offset(0, 1)
Wend
NextColumn = NextCol.Column
End Function
'returns the row number of the first empty cell below Target
Function NextRow(ByVal Target As Range) As Long
Dim NextRow_ As Range
Set NextRow_ = Target
While Not IsEmpty(NextRow_.Value)
Set NextRow_ = NextRow_.Offset(1, 0)
Wend
NextRow = NextRow_.Row
End Function
--------------------
Hope this helps... :)
--
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
Reply With Quote
T-容x[_50_]
View Public Profile
Find all posts by T-容x[_50_]