根据单元格值将行复制到工作簿表中

Question

Am very new and have been trying my best to self help myself but after a hour or so I have give up and now need help, I am trying to use the below code I have found on here to copy the "OK" lines in Workbook 1 sheet 1 column I into a new sheet in workbook 2 sheet 1.

I don't need to copy the "ERROR" part but have left this in until I got the code working.

I would also like to keep all the data copied in to workbook 2 as at the moment the previous date is being replaced with the new data.

    FilterAndCopy()

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


Dim lngLastRow As Long
Dim OKSheet As Worksheet, ErrorSheet As Worksheet

Set OKSheet = Sheets("Sheet1") ' Set This to the Sheet name you want all Ok's going to
Set ErrorSheet = Sheets("Sheet2") ' Set this to the Sheet name you want all Error's going to

lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row


With Range("A1", "I" & lngLastRow)
    .AutoFilter
    .AutoFilter Field:=9, Criteria1:="OK"
    .Copy OKSheet.Range("A1")
    .AutoFilter Field:=9, Criteria1:="ERROR"
    .Copy ErrorSheet.Range("A1")
    .AutoFilter
End With


Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub

Thanks

Answer 1

Well your code is not working because you need to write

 sub FilterAndCopy()

At the beggining of your sub, try it and see if it works.

What you can do to check if there is data in the colum is:

Dim r as range
set r = Range("a1")
 while r.value <> ""
  r= r.offset(0,1)
 end while

and use "r" as your paste range instead of A1