Auto Record Transfer

[Guest]

Dear all,

I've a workbook with VBA code (written by an expert in this discussion group
- Roman) for tranferring records from one worksheet to another. The code is
as follows:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler
Application.EnableEvents = False
If Target.Count = 1 And Target.Column = 4 And Target.Value = "Y" Then
Dim eRow As Long
eRow = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(Target.Row, 1), Cells(Target.Row, 4)).Copy _
Sheets("Completed").Cells(eRow, 1)
Rows(Target.Row).Delete
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

My question is, if I want to transfer several rows of records to another
sheet in one time, after I typed "Y" in one row and copied down to other
cells in the same column by dragging the cell handle, only the first record
is transferred. Other rows with "Y" have no action and remain in the first
worksheet. Any methods can help? Please kindly advise.

Thanks in advance.

 

[Bernie Deitrick]

Freshman,

Try the version below.

HTH,
Bernie
MS Excel MVP


Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
On Error GoTo ErrorHandler
Application.EnableEvents = False
If Target.Column = 4 And Target(1).Value = "Y" Then
Dim eRow As Long
eRow = Sheets("Completed").Cells(Rows.Count, 1).End(xlUp).Row + 1
For Each myCell In Target
myCell.Offset(0, -3).Resize(, 4).Copy _
Sheets("Completed").Cells(eRow, 1)
eRow = eRow + 1
Next myCell
Target.EntireRow.Delete
End If
ErrorHandler:
Application.EnableEvents = True
End Sub

 

[Guest]

Dear Bernie,

Thanks for your revised code and it works prefectly.

Thanks once again.

Freshman