Macro to Copy Rows based on target cell value and paste in another sheet. Help Needed!

Hi All,

I have attached a sample workbook. I am trying to Run a Macro in the "Regional Stats" Sheet that will copy all rows from the "Data Summary" sheet where the cell in column J is less than -999 and paste them back in the "Regional Stats" sheet from row 6 on because there will be other information in rows 1-5.

The code I wrote clears the contents of all rows (6 down) in the regional stats sheet first so that duplicates don't occur and the info will always start at row 6 when the Macro is run twice. The Data Summary sheet will be updated periodically with new information but will also retain the old information so I don't want duplicate entries in the Regional Stats sheet every time I run the macro.

I can't seem to get it to work correctly so If someone could help me out it would be great! Also if anyone has input I would like to know if what I wrote is the most efficient way of achieving this. If there is a more efficient VBA script I would be all for it.

The Macro seems to work ok and then when the Data Summary sheet gets sorted it breaks. I need to be able to sort it as people will be adding data sorting the Data summary sheet and then Management will be using the Macro to pull only the info they need to the Regional Stats sheet to avoid looking through rows of data for what they want.

Here is the COPY AND PASTE code I am using

Sub Return_ColumnJ_Values()
Dim ws1 As Worksheet:   Set ws1 = Sheets("Data Summary")
Dim ws2 As Worksheet:   Set ws2 = Sheets("Regional Stats")
Dim lastrow As Long
Dim myRange As Range, icell As Range

ThisWorkbook.Sheets("Regional Stats").Rows("6:6553").ClearContents 'clear

lastrow = ws1.Range("J" & Rows.Count).End(xlUp).Row

Set myRange = ws1.Range("J3:J" & lastrow).SpecialCells(xlCellTypeConstants)
For Each icell In myRange
    If IsNumeric(icell) Then
        If icell.Value < -999 Then
            icell.EntireRow.Copy Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Else
        icell.EntireRow.Copy Destination:=ws2.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
    End If
Next icell

End Sub

All input is greatly appreciated!!