Copy and Paste based on a cell value

[DPD]

Hello,

I have two sheets. Phase I and Phase II. Phase I I have columns A-J. Im looking for a macro which would copy columns A-F and paste it to sheet Phase II A5 when value of column J on sheet Phase I is yes. I have the following macro which worked before but no longer working. Thank you.

Sub Yes1()
'Copy from one sheet to another based on cell value
Application.ScreenUpdating = False
Dim i As Integer
Dim lastRow As Long
Dim LastroWB As Long
lastRow = Cells(Rows.Count, "J").End(xlUp).Row + 1
LastroWB = Sheets("Phase II").Cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 2 To lastRow

If Cells(i, 10).Value = "YES" Then
Range(Cells(i, 1), Cells(i, 6)).Copy Sheets("Phase II").Rows(LastroWB)
LastroWB = LastroWB + 1
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[Luke M]

Give this a try. Rather than looping, can get all the rows in one shot with AutoFilter.

Sub CopyRows()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim rngCopy As Range
   
    'Which worksheets are we dealing with?
    Set wsSource = ThisWorkbook.Worksheets("Phase I")
    Set wsDest = ThisWorkbook.Worksheets("Phase II")
   
    Application.ScreenUpdating = False
    With wsSource
       
        'Apply filter, if not already on
        If .AutoFilterMode Then
            .AutoFilter.ShowAllData
        Else
            .Range("A:J").AutoFilter
        End If
       
        'Apply filter to col J for 'yes'
        With .AutoFilter.Range
            .AutoFilter field:=10, Criteria1:="yes"
           
            'Get copy area
            On Error Resume Next
            Set rngCopy = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            On Error GoTo 0
           
            'If there was at least one visible row, copy it
            If Not rngCopy Is Nothing Then
                rngCopy.Copy
                wsDest.Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End If
        End With
       
        'Clear the filter
        .AutoFilterMode = False
    End With
   
    'Clean-up
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub