Need Help Moving And Copying Data Creating An Archive Of Values

Posted by Stone on December 05, 2001 6:24 PM

I need some help modifying the code below so I can achieve the following:

As data is entered into Worksheet 1, A1, I want to copy the data to Worksheet 2, A1:A200. Example: I enter a value of 5 in Worksheet 1, A1 and it is copied to Worksheet 2, A1 (my current code allows this). My next entry in Worksheet 1, A1, is copied to Worksheet 2, A2, leaving my previous entry in A1 and so on.

I want to create an archive of data that I can refer back to and chart at a later date.

Thanks in advance...

Sub CopyIt()
Dim FromRange As Range
Dim ToRange As Range
Set FromRange = Worksheets("1").Range("a1")
Set ToRange = Worksheets("2").Range("a1")
FromRange.Copy ToRange
FromRange.Copy
Worksheets("1").Paste Worksheets("2").Range("a1")
End Sub

Posted by Bariloche on December 05, 2001 8:11 PM

Stone,

I'd recommend taking advantage of the worksheet change event instead. Using the code below, all you have to do is enter your number anywhere on the sheet (it doesn't care what cell you enter it in, if you want to enter it in A1 that's OK).

To use this code, right click on your data entry sheet tab and select "View Code", paste the following code into the code sheet that pops up.

Note: I've named the archive sheet "Sheet2" (pretty original, huh?!) if your's has a different name, just change the code accordingly.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

If Sheets("Sheet2").Cells(1, 1).Value = "" Then
EntryRow = Sheets("Sheet2").Cells(65536, 1).End(xlUp).Row
Else
EntryRow = Sheets("Sheet2").Cells(65536, 1).End(xlUp).Row + 1
End If

Sheets("Sheet2").Cells(EntryRow, 1).Value = Target.Value

End Sub

enjoy

Posted by Colo on December 05, 2001 8:11 PM

Hi.Works with XL97.

'sample1
Sub CopyIt()
Dim FromRange As Range, ToRange As Range
Set FromRange = Worksheets("1").Range("a1")
With Worksheets("2").Range("a65536").End(xlUp)
If IsEmpty(.Value) Then
Set ToRange = .Offset(0)
Else
Set ToRange = .Offset(1)
End If
FromRange.Copy ToRange
End With
End Sub

If the event macro is used, automatic processing is also possible.
In that case, the code is described in the seat module.

'sample2
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim ToRange As Range
If Target.Address &LT;&GT; "$A$1" Then Exit Sub
With Worksheets("2").Range("a65536").End(xlUp)
If IsEmpty(.Value) Then
Set ToRange = .Offset(0)
Else
Set ToRange = .Offset(1)
End If
Target.Copy ToRange
End With
End Sub