Transferring Data between sheets automatically

[PepperJ1981]

I only know basic Excel, so this one is rough for me. Here's my problem.

I have one Excel 2003 file with 2 sheets. I'm trying to make it so that
when the data is filled for one row on sheet 1 (using a colum to mark 'x' for
complete), it will transfer to the next empty row on sheet two, and delete
that row from sheet one. Here's an example..

Row 4 on sheet 1 has all the info it needs, so the user marks X on column J.
When that column on row 4 is marked X, it will copy that row to the next
empty row on sheet 2, and then delete that row from sheet 1.

Is there any way to do this? I'm sure there is, but I'm unsure on how to do
it. Please respond with any advice you can offer. You can also email me the
how-to at (e-mail address removed). Thank you all for whatever help you can offer.

 

[JLGWhiz]

Paste this code into the sheet you enter the "x" in column "J".

Private Sub Worksheet_Change(ByVal Target As Range)
lr = Cells(Rows.Count, 10).End(xlUp).Row
Set srcRng = Range("J1:J" & lr)
If Not Intersect(Target, srcRng) Is Nothing Then
If LCase(Trim(Target.Value)) = "x" Then
Target.EntireRow.Copy Sheets(2). _
Range("A65536").End(xlUp).Offset(1, 0)
End If
End If
End Sub

 

[Gord Dibben]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
If Target.Column <> 10 Then Exit Sub
If Target.Value = "x" Then
Set rng1 = Target.Offset(0, -9).Resize(1, 9)
Set rng2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp) _
.Offset(1, 0)
With rng1
.Copy Destination:=rng2
.EntireRow.Delete
End With
End If
End Sub

Right-click on the sheet tab and "View Code". Copy/paste into that module.


Gord Dibben MS Excel MVP

 

[PepperJ1981]

Works pretty well. But I'm still looking to have the row that got copied
deleted off of sheet 1. Thanks for the prompt response

 

[JLGWhiz]

Sorry, I overlooked the delete requirement. Here is the modified version.

Private Sub Worksheet_Change(ByVal Target As Range)
lr = Cells(Rows.Count, 10).End(xlUp).Row
Set srcRng = Range("J1:J" & lr)
If Not Intersect(Target, srcRng) Is Nothing Then
If LCase(Trim(Target.Value)) = "x" Then
Target.EntireRow.Copy Sheets(2). _
Range("A65536").End(xlUp).Offset(1, 0)
Rows(Target.Row).Delete
End If
End If
End Sub