Hi Jim,

Try:
'===================
Public Sub CopyRows()
Dim Rng As Range
Dim Rng2 As Range
Dim rCell As Range
Dim WB As Workbook
Dim SH As Worksheet
Dim SH2 As Worksheet
Dim CalcMode As Long

Set WB = ActiveWorkbook '<<========== CHANGE
Set SH = WB.Sheets("Sheet1") '<<========== CHANGE
Set SH2 = WB.Sheets("Sheet2") '<<========== CHANGE

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

Set Rng = SH.Range("A1").CurrentRegion
Set Rng2 = Rng.Rows(1)

For Each rCell In Rng.Columns(1).Cells
If UCase(rCell.Offset(0, 18).Value) = "RELEASED" Then
Set Rng2 = Union(rCell, Rng2)
End If
Next rCell

If Not Rng2 Is Nothing Then
Rng2.EntireRow.Copy Destination:=SH2.Range("A1")
Else
'nothing found, do nothing
End If

With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub
'<<===================


You could also use the Advanced filter feature, invokink th filter from the
destination sheet.


---
Regards,
Norman



"Jim May" wrote in message
news:XQG_e.123055$Ep.21820@lakeread02...
My Sheet 1 contains 25 Columns - 30 rows of data, where row1 = The Header
rows;
In Sheet1 - Column 19 is label "STATUS".
How can I MOVE all records (the complete row data) from Sheet1 to Sheet2
(with the Same headers) ONLY
for records (on Sheet1) where STATUS = "RELEASED" (without the quote
marks) ?
Tks in Advance,,
Jim