VBA Optimization

[MKader]

Dear All,

Kindly need your assistance with the below code - How to make it run faster - it takes almost 1 min to find the data and copy and paste - all open windows freeze and nothing is working properly till the process ends,

awaiting your kind feedback,

Sub CopyData()Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


Dim lRow As Long


lRow = Range("A" & Rows.Count).End(xlUp).Row


Sheets("Raw").Select


For Each cell In Range("J7:J" & Rows.Count)
    If cell = "X" Or cell = "Y" Then    cell.EntireRow.Copy
    Sheets("New").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteAll
    cell.EntireRow.ClearContents
    End If
    
Next cell


With ActiveSheet.AutoFilterMode = False
    With Range("A7", Range("A" & Rows.Count).End(xlUp)).AutoFilter 1, "" On Error Resume Next    .Offset(1).SpecialCells(4).EntireRow.Delete
    End With
    
    .AutoFilterMode = False
End With


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.CutCopyMode = False


Sheets("New").Select


End Sub

Thanks,
MK

 

[RoryA]

Since you're filtering already, why don't you just filter for the values you want, copy the visible cells o the other sheet, then delete the visible rows?