optimize code

[acer4605]

Dears I have the below vba code which is working fine.
only disadvantage that I have is that it stresses my laptop during execution on a sheet of give or take 5600 lines)
on top of that I loose the complete menubar on top of the screen
what do I need to do to optimize my code so that the menu bar

remains visible and that my code is less stressfull for my machine

ub CopyFULLtoNewSheet()
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    On Error Resume Next
    Dim I As Long
    Dim ws As Worksheet
    Dim nws As Worksheet
    Dim sSearch As String
    Dim wb As Workbook
    Dim strpath As String
    Dim strFile As String
    
    strFile = "intunes.csv"
    strMypath = Environ("userprofile") & "\OneDrive\Documents\excel\"
    If Len(Dir(strMypath, vbDirectory)) = 0 Then
       MkDir Environ("userprofile") & "\OneDrive\Documents\excel\"
    End If
    strMypath = strMypath & strFile
 
    Workbooks.Open Filename:=strMypath, local:=False
    Application.StatusBar = "Replacing Windows with windows"
    Columns("G").Replace What:="Windows", _
                            Replacement:="windows", _
                            LookAt:=xlPart, _
                            SearchOrder:=xlByRows, _
                            MatchCase:=False, _
                            SearchFormat:=False, _
                            ReplaceFormat:=False
    
    
    
    'sSearch = InputBox("enter emailaddress")
    sSearch = "windows"
    Set ws = ActiveSheet
    lastrow = Cells(Rows.Count, "E").End(xlUp).Row
    Dim wsName As String: wsName = "Windows"
    If (Worksheets("Windows").Name = "") Then
        Worksheets.Add().Name = wsName
        Set nws = ActiveSheet
        ws.Select
        Range("A1:AM1").Copy
        lastrow = Cells(Rows.Count, "G").End(xlUp).Row
        nws.Select
        Range("A1").Select
        ActiveSheet.Paste
    Else
        Sheets("NewSheet").Select
        Set nws = ActiveSheet
    End If
    For I = 2 To lastrow
        DoEvents
        appliction.ScreenUpdating = True
        Application.StatusBar = "busy " & I
        ws.Select
        If LCase(Cells(I, "G")) = sSearch Then
            Range(("A" & I) & ":" & ("AM" & I)).Copy
            nws.Select
            nsLR = Cells(Rows.Count, "G").End(xlUp).Row
            Range("A" & nsLR + 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Paste:=xlcolumnwidths
        End If
    Next I
    Application.StatusBar = "Done"
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    On Error GoTo 0
    nws.Select
    Range("A2").Select

End Sub

thanks for your help in this

 

[acer4605]

Question
would it be faster to enter all the data in a string/array and do the search through the array/string? and if yes how would I implement this

 

[acer4605]

sorry to bump anyone?
help would be much appreciated