Transfering records based on a condition
Hi OldJay,
Try something like:
'============
Public Sub CopyRange()
Dim WB As Workbook
Dim SH As Worksheet
Dim destSH As Worksheet
Dim destRng As Range
Dim rng As Range
Dim copyRng As Range
Dim rCell As Range
Dim LRow As Long
Dim CalcMode As Long
Const sStr = "X"
Set WB = Workbooks("MyBook.xls") '<<==== CHANGE
With WB
Set SH = .Sheets("Sheet1")
Set destSH = .Sheets("Verified")
End With
Set destRng = destSH.Cells(Rows.Count, "A").End(xlUp)(2)
LRow = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = SH.Range("A1:A" & LRow)
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For Each rCell In rng.Cells
If InStr(1, rCell, sStr, vbTextCompare) 0 Then
If copyRng Is Nothing Then
Set copyRng = rCell.Offset(0, 1).Resize(1, 4)
Else
Set copyRng = _
Union(rCell.Offset(0, 1).Resize(1, 4), copyRng)
End If
End If
Next rCell
If Not copyRng Is Nothing Then
copyRng.Copy Destination:=destRng
End If
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'<<============
---
Regards,
Norman
"Oldjay" wrote in message
...
I have a list of records. I want to move all of the records (cols B thru E)
to sheet "Verified "if the value in the A col is a "X" . The Records will
be
added to the bottom of the existing list in Sheet "Verified"
oldjay
|