Selectively copy and paste rows with given criteria

Question

I am trying to select rows in a table based on the word "Yes" being present in column J.

I have a table going from column A to J, and I want to select the rows where there is a "Yes" in column J and paste only those rows into a new sheet.

Once selected, I need to copy these rows to a new sheet or word document.

I have tried a range of forumulas, this is for Windows MS Excel software, using a VBA Macro.

I am using the following VBA, but having issues:

Sub Macro1()
 Dim rngJ As Range
    Dim cell As Range

    Set rngJ = Range("J1", Range("J65536").End(xlUp))
    Set wsNew = ThisWorkbook.Worksheets.Add

    For Each cell In rngJ
        If cell.Value = "Yes" Then
            cell.EntireRow.Copy

            wsNew.Sheets("Sheet1").Range("J65536").End(xlUp).Offset(1, 0).Select

            ActiveSheet.Paste
        End If
    Next cell

End Sub

Any help would be very much appreciated!

*having issues* - what issues? Post the error message if that's what you're getting, or the expected and actual results if your code runs to completion. — jsheeran, May 28 '19 at 14:48
`wsNew` is a worksheet. You're likely getting an error when you do `wsNew.Sheets("Sheet1")...`? I *think* you would want to just do `wsNew.Range("J66536").End(xlUp).Offset(1,0).Paste`? — BruceWayne, May 28 '19 at 14:50
@BruceWayne - agreed, though I think pasting an entire row starting at J might also cause an error? — SJR, May 28 '19 at 14:56
Note: Don't hard code the last cell. Recent Excel verions have much more than 65536 rows use `Range("J" & Rows.Count)` instead. • And you might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — Pᴇʜ, May 28 '19 at 14:57
Hi @jsheeran, thanks for getting back to me so quickly! My error message is 'Run Time Error 438, Object does not support this property or method'. This occurs in the wsNew.Sheets line — PKen, May 28 '19 at 15:01
@SJR - Good catch - OP may want `wsNew.Range("J66536").End(xlUp).Offset(1,0).EntireRow.Paste` (I think that's a legit command...can't remember exactly where `EntireRow` would go) — BruceWayne, May 28 '19 at 15:03
@BruceWayne thank you for your suggestion! That stops an error coming up, but just creates a new blank sheet without pasting anything in.. — PKen, May 28 '19 at 15:04
You should qualify which sheet `RngJ`'s data is on. Currently it'll use whatever the active sheet is. You want to do something like `set rngJ = Worksheets("SheetName").Range(...)`. Also I suggest stepping through your code with `F8`, as it'll go line by line and you can more easily follow it and see where it goes awry. — BruceWayne, May 28 '19 at 15:05
@Pᴇʜ, thank you :) How do I not hard code the last cell? Can I just do Range("J1", Range("J").End.....? — PKen, May 28 '19 at 15:05
You *could* do that, but it would make a rather ugly range. I tend to do `Dim lastRow as Long // lastRow = Range("J" & rows.count).End(xlUp).Row` and use that, e.g. `Range("J" & lastRow + 1).Value = "New Text"` — BruceWayne, May 28 '19 at 15:07
@AAA to either a new generated sheet or an already existing sheet e.g. "FinalSpec" — PKen, May 28 '19 at 15:25
@BruceWayne thank you :) Still struggling with this one: wsNew.Range("J66536").End(xlUp).Offset(1,0).EntireRow.Paste I'm getting an error saying 'Object does not support this method'. — PKen, May 28 '19 at 15:34
Why are you pasting in "J66536". You just want to paste in the new sheet, right? — AAA, May 28 '19 at 15:39
@AAA yes I just want to paste into the new sheet, should I do wsNew.Range("J").End(xlUp).Offset(1,0).EntireRow.Paste — PKen, May 29 '19 at 08:42
Thanks all so much for your help. I am still struggling to get the rows to paste into the new sheet where the column J in the original sheet has a "Yes" in the cell. — PKen, May 29 '19 at 08:54
So I could just have wsNew.Range.End(xlUp).Offset(1, 0).Paste ActiveSheet.Paste ?? @AAA — PKen, May 29 '19 at 09:09
@PKen, check my answer below, which works and is also more efficient. — AAA, May 29 '19 at 11:45

Pᴇʜ · Answer 1 · 2019-05-28T15:29:41.477

Use something like this

Option Explicit

Public Sub CopyYesRowsToNewWorksheet()
    Dim wsSource As Worksheet
    Set wsSource = ThisWorkbook.ActiveSheet 'better define sheet by name ThisWorkbook.Worksheets("SourceSheet")

    Dim DataRangeJ As Variant 'read "yes" data into array for faster access
    DataRangeJ = wsSource.Range("J1", wsSource.Range("J" & wsSource.Rows.Count).End(xlUp)).Value

    Dim wsNew As Worksheet
    Set wsNew = ThisWorkbook.Worksheets.Add

    Dim NextFreeRow As Long
    NextFreeRow = 1 'start pasting in this row in the new sheet

    If IsArray(DataRangeJ) Then        
        Dim iRow As Long
        For iRow = LBound(DataRangeJ) To UBound(DataRangeJ) 'loop through data array
            If DataRangeJ(iRow, 1) = "yes" Then
                wsNew.Rows(NextFreeRow).Value = wsSource.Rows(iRow).Value 'copy the values of the row
                NextFreeRow = NextFreeRow + 1
            End If
        Next iRow
    ElseIf DataRangeJ = "yes" Then 'if only the first row has data
        wsNew.Rows(NextFreeRow).Value = wsSource.Rows(1).Value
    End If
End Sub

The line

wsNew.Rows(NextFreeRow).Value = wsSource.Rows(iRow).Value

only copys the value without formatting. If you also want to copy the formatting replace it with

wsSource.Rows(iRow).Copy Destination:=wsNew.Rows(NextFreeRow)

Hi @PEH, thank you so much for your help and kind explanation! I get a mismatch error with this on the line@ For iRow = LBound(DataRangeJ) To UBound(DataRangeJ) 'loop through data array Any ideas why this may be? — PKen, May 28 '19 at 15:24
Hi @Pᴇʜ Thanks for your help. This code manages to create a new sheet, but nothing gets copied over. I have a table going from column A to J, and I want to select the rows where there is a "Yes" in column J and paste only those rows into a new sheet... — PKen, May 29 '19 at 08:52

score 1 · Accepted Answer · answered May 29 '19 at 11:40

Rather than finding, copying and pasting for each cell, why not find all, then copy and paste once like this:

Sub Macro1()
Dim rngJ As Range
Dim MySel As Range

Set rngJ = Range("J1", Range("J" & Rows.Count).End(xlUp))
Set wsNew = ThisWorkbook.Worksheets.Add

For Each cell In rngJ
    If cell.Value = "Yes" Then
        If MySel Is Nothing Then
            Set MySel = cell.EntireRow
        Else
            Set MySel = Union(MySel, cell.EntireRow)
        End If
    End If
Next cell

If Not MySel Is Nothing Then MySel.Copy Destination:= wsNew.Range("A1")
End Sub

It's better to avoid using Select as much as possible; see this link.

Selectively copy and paste rows with given criteria

2 Answers2

Linked