EntireRow copy/paste won't stop

[fourmurphys]

The code below 'works' but doesn't stop.

It correctly takes the first x number of rows with "y" in column F of sheet a and pastes them one after another on sheet b. Instead of stopping after the last "y", however, it then takes the first "y" row occurrence of sheet a and fills that in every row to the very end of sheet b (row 1,048,576). So sheet b does have what I need, then about 1,048,500 more rows that I don't need....

Thanks in advance for any help.

    Dim cel As Range
    Worksheets("sheet a").Activate
    For Each cel In Range("f2:f1000")
        If cel.Value = "y" Then
        cel.EntireRow.Copy
        Worksheets("sheet b").Activate
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveCell.Offset(1, 0).Select
        End If
    Next

[karmapala]

because the active sheet now is not sheet a anymore
maybe try like this:

Dim cel As Range
    Worksheets("sheet a").Activate
    For Each cel In Range("f2:f1000")
        If cel.Value = "y" Then
        cel.EntireRow.Copy
        Worksheets("sheet b").Activate
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveCell.Offset(1, 0).Select
        End If
       Worksheets("sheet a").Activate
    Next

FYI, it will show you sheet a and sheet b back n forth.

If you know what row to be pasted in sheet b, (the last blank row, for example)
the code can be modified.

[fourmurphys]

Odd... I've used this little bit of code for years (below), and only revised it slightly for the new file. Never had this happen before... was always switching between 2 sheets without issue.
Any ideas what I could look for that might be causing the new issue, if it isn't the sheet switching?

    Dim cel As Range
    Worksheets("sheet a").Activate
    For Each cel In Range("A4:A150")
        If cel.Value = "y" Then
        cel.EntireRow.Copy
        Worksheets("sheet b").Activate
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveCell.Offset(1, 0).Select
        End If
    Next

[karmapala]

Try to put line :

cel.select

right below this line

For Each cel In Range("A4:A150")

Do debug F8,
and see what happen when actually it should find the "Y" for the second time in the looped cel.

[bakerman2]

There are much better ways to do this but this will get you started.

Instead of copying entire rows just change 4 in Resize (both times) to the number of columns that need to be copied.

Sub tst()
    With Sheets("sheet a")
        For Each cl In .Range("A4", .Range("A" & .Rows.Count).End(xlUp))
            If cl.Value = "y" Then
                Sheets("sheet b").Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(, 4).Value = cl.Resize(, 4).Value
            End If
        Next
    End With
End Sub

[fourmurphys]

Instead of copying entire rows just change 4 in Resize (both times) to the number of columns that need to be copied.

This works, but how can I revise such that it captures columns also that precede the "y" column? "Y" column is column F, and would need to copy A through P.

Thanks

[bakerman2]

Sub tst()
    With Sheets("sheet a")
        For Each cl In .Range("F4", .Range("F" & .Rows.Count).End(xlUp))
            If cl.Value = "y" Then
                Sheets("sheet b").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 16).Value = .Range("A" & cl.Row).Resize(, 16).Value
            End If
        Next
    End With
End Sub

If you were to post an example workbook then we could propose better ways to do this.(like Autofilter or AdvancedFilter)

[fourmurphys]

If you were to post an example workbook then we could propose better ways to do this.(like Autofilter or AdvancedFilter)

My apologies, thought I had on this one... I'll try this latest and will upload sample file if I'm still having issues.
Thank you very much for your help!

[fourmurphys]

That did indeed fix it bakerman! Thank you!

[bakerman2]

You're welcome and thanks for rep+.