Search range and copy cells to sheet2 if, if statement is true

1) Turn on the Data > Filter for that data set
2) Use the drop down in column D to filter for "Y"
3) Copy all visible rows all at once to another sheet.

Should take you about 5 seconds.

If it must be code:

Sub SendIfYes()

Dim ws1        As Worksheet
Dim ws2        As Worksheet
Dim rngSource  As Range
Dim rngDest    As Range

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws2 = ThisWorkbook.Sheets("Sheet2")
Set rngSource = ws1.Range("D2:D100")

With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With
   
   For Each rngCell In rngSource
      If rngCell.Value = "Y" Then
         With ws2
            Set rngDest = .Range("A64333").End(xlUp).Offset(1)
         End With
         rngDest.Value = rngCell.Offset(0, -3).Value
      End If
   Next
   
With Application
   .EnableEvents = True
   .ScreenUpdating = True
End With

End Sub

Hi pinstripe05,

Welcome to the forum!!

See how this goes:

Option Explicit
Sub Macro1()

    'http://www.excelforum.com/excel-programming-vba-macros/857705-search-range-and-copy-cells-to-sheet2-if-if-statement-is-true.html

    Dim rngCell As Range
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Sheets("Sheet1").Range("D2:D100")
        If rngCell.Value = "Y" Then 'Criteria to copy value (case sensitive)
            If lngMyRow = 0 Then
                lngMyRow = 2 'Initial row output. Change to suit.
            Else
                lngMyRow = lngMyRow + 1
            End If
            Sheets("Sheet2").Range("A" & lngMyRow).Value = Sheets("Sheet1").Range("A" & rngCell.Row)
        End If
    Next rngCell
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert

Hi pinstripe05,

Try this:

Option Explicit
Sub Macro1()

    'http://www.excelforum.com/excel-programming-vba-macros/857705-search-range-and-copy-cells-to-sheet2-if-if-statement-is-true.html

    Dim rngCell As Range
    Dim lngMyRow As Long
    
    Application.ScreenUpdating = False
    
    For Each rngCell In Sheets("Sheet1").Range("D2:D100")
        If rngCell.Value = "Y" Then 'Criteria to copy value (case sensitive)
            If lngMyRow = 0 Then
                lngMyRow = 2 'Initial row output. Change to suit.
            Else
                lngMyRow = lngMyRow + 1
            End If
            With Sheets("Sheet2")
                .Range("A" & lngMyRow).Value = Sheets("Sheet1").Range("A" & rngCell.Row)
                .Range("B" & lngMyRow).Value = Sheets("Sheet1").Range("C" & rngCell.Row)
            End With
        End If
    Next rngCell
    
    Application.ScreenUpdating = True

End Sub

Robert

I have marked this thread solved for you.
In the future please select Thread Tools from the menu above and mark the thread as solved. Thanks.