Extracting data to another worksheet

[Sparky]

I have a worksheet where Yes or No appears in column A. I require all the rows with Yes to be copied across to another worksheet in the same workbook. Hope someone can help with a piece of code or a formula.

Thanks

 

[jeffreybrown]

Hi Sparky,

How about...

Sub MoveData()
    Dim r As Range, LR As Long
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Set r = .Range("A2").Resize(LR - 1)
        .Range("A1").AutoFilter field:=1, Criteria1:="Yes"
        With r.SpecialCells(xlCellTypeVisible).EntireRow
            .Copy Destination:=Sheets("Sheet2").Range("A2")
        End With
        .Range("A1").AutoFilter
    End With
End Sub

 

[Sparky]

Jeff

The code works fine.

Thanks for your help

 

[jeffreybrown]

Hi Sparky,

Thanks for the feedback and your very welcome

 

[Sparky]

Jeff

The code always seems to pick up the first row of data from sheet1 irrespective if it is YES or NO.

Two or three times a day I will update sheet1 with fresh data and occasionally delete some or all of the data as it is used. If I delete from sheet1 is there a way for it to automatically delete in sheet2. The method I am using to delete is by selecting the numbered rows, right click and select delete.

Hope you can help.

 

[Sparky]

Jeff

I have had a look at the resize property to see what its purpose is. As this (resize LR -1) is to allow for the table I have now placed header names above the data in Sheet1. This seems to have done the trick. Please correct me if I am wrong.

Thanks again

 

[jeffreybrown]

Hi Sparky,

Yes, having headers to your data is vitally important. The idea of an autofilter is to have a header to filter on or else you are confusing Excel.

Not entirely sure what you want to do (delete) and when or why, but the updated code below will not only filter the data on sheet1 and move it to sheet2, but will also delete from sheet1 what you just moved to sheet2.

If you need something else please provide more details as to what you would like to achieve?

Sub MoveData()
    Dim r As Range, LR As Long
    With Sheets("Sheet1")
        LR = .Range("A" & Rows.Count).End(xlUp).Row
        Set r = .Range("C2").Resize(LR - 1)
        .Range("A1").AutoFilter field:=3, Criteria1:="Replace"
        With r.SpecialCells(xlCellTypeVisible).EntireRow
            .Copy Destination:=Sheets("Sheet2").Range("A5")
            [COLOR="Red"].Delete[/COLOR]        
     End With
        .Range("A1").AutoFilter
    End With
End Sub