Something like this :-

'---------------------------------------------------------
Sub transfer_data()
Dim FromSheet As Worksheet
Dim ToSheet As Worksheet
Dim FromRow As Long
Dim ToRow As Long
Dim LastRow As Long
Dim FindValue
'--------------------------
Application.Calculation = xlCalculationManual
Set FromSheet = ActiveSheet
Set ToSheet = Workbooks("Book1.xls").Worksheets("data")
LastRow = ToSheet.Range("A65536").End(xlUp).Row + 1
FromRow = 2
While FromSheet.Cells(FromRow, 1).Value < ""
FindValue = FromSheet.Cells(FromRow, 1).Value
'- check for transfer or not
If FindValue 10 Then
FromSheet.Range("A" & FromRow & ":H" & FromRow).Copy
ToSheet.Paste Destination:=ToSheet.Range("A" & LastRow)
LastRow = LastRow + 1
'- delete row
FromSheet.Rows(FromRow).EntireRow.Delete
Else
FromRow = FromRow + 1
End If
Wend
Application.Calculation = xlCalculationAutomatic
MsgBox ("Done")
End Sub
'---------------------------------------------------------------

--
Message posted from http://www.ExcelForum.com