Excel Macro: conditional cut and paste between workbooks

So I want a macro running in an Excel file ("input.xls") that is searching a column in another Excel file ("data.xls") for the value "1" (the only values in that columns are 1s and 0s). When it finds a "1," it should copy and paste the entire row from that file into "input.xls".

Here is the code that I have

Sub NonErrorDataParse()
    Dim intEnd As Integer

    Workbooks("data.xls").Sheets("Raw").Activate

    intEnd = 65000

    Range("F").Select

    Do Until ActiveCell.Row = intEnd

        If Int(ActiveCell.Value) = 1 Then
            Range(ActiveCell.Row & ":" & ActiveCell.Row).Cut
            intEnd = intEnd - 1
            Workbooks("input.xls").Sheets("Non-errors").Activate
            Range("A1").Select
            ActiveSheet.Paste
        Else
 开发者_开发问答           ActiveCell.Offset(1, 0).Select
        End If

    Loop

End Sub

However, when I run it, it gives me a "subscript out of range" error on "data.xls." No matter how I fiddle with the code I can't seem to get past that error (even though I have OTHER macros that are accessing that sheet that work fine).

Any ideas as to how to fix it? Or better code that will do the same thing?

Thanks in advance

You don't have to Select or Activate each time you do a command.
You can also find the last used cell with Range("A65536").End(xlup) instead of parsing every cell (that probably caused your error).

The code would then look like:

Sub NonErrorDataParse()
    Dim intEnd As Integer
    Dim c As Range

    intEnd = Workbooks("data.xls").Sheets("Raw").Range("A65536").End(xlUp).Row

    For Each c In Workbooks("data.xls").Sheets("Raw").Range("F1:F" & intEnd)
       If CStr(c.Value) = "1" Then
           c.EntireRow.Cut
           Workbooks("input.xls").Sheets("Non-errors").Rows("1:1").Insert Shift:=xlDown
       End If
    Next c
End Sub

Yet, if you have many rows, it would be faster to use the autofilter method or use a dictionary.