View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Norman Jones Norman Jones is offline
external usenet poster
 
Posts: 5,302
Default 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