Macro eseguite con eccessiva lentezza dopo gli ultimi aggiornamenti

Sub INCOLONNAMENTO()
Sheets("INCOLONNAMENTO CON MACRO").Select
Dim I As Long'Integer
Range("E3:G10000").ClearContents
Application.ScreenUpdating = False
Range(Cells(3, 1), Cells(3, 3)).Copy
Range("E3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Application.CutCopyMode = False
For I = 4 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(I, 1) > Cells(Range("E" & Rows.Count).End(xlUp).Row, 5) Then
   Range(Cells(I, 1), Cells(I, 3)).Copy
   Cells(Range("E" & Rows.Count).End(xlUp).Row + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
   'Application.CutCopyMode = False
End If
If Cells(I, 2) - Cells(Range("E" & Rows.Count).End(xlUp).Row, 6) >= Cells(1, 7) Then
   Range(Cells(I, 1), Cells(I, 4)).Copy
   Cells(Range("E" & Rows.Count).End(xlUp).Row + 1, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   :=False, Transpose:=False
   'Application.CutCopyMode = False
End If
Next I
Application.CutCopyMode = False
Application.ScreenUpdating = True
Cells(1, 5).Select
End Sub

Sub INCOLONNAMENTO()
Dim mArrF() As Variant, mArrTo() As Variant, lr As Long, k As Long, indx As Long, c As Byte
Dim I As Long, s As Boolean
On Error GoTo merr
Sheets("INCOLONNAMENTO CON MACRO").Select

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

lr = Range("A" & Rows.Count).End(xlUp).Row
mArrF = Range("A3:C23")
k = 2
ReDim mArrTo(1 To lr, 1 To 3)
For c = 1 To 3
    mArrTo(1, c) = mArrF(1, c)
Next c

Range("E3:G10000").ClearContents
indx = 2
For I = 4 To lr
    If mArrF(indx, 1) > mArrTo(k - 1, 1) Then
        For c = 1 To 3
            mArrTo(k, c) = mArrF(indx, c)
            mArrTo(k, c) = mArrF(indx, c)
        Next c
        s = True
    End If
    
    If mArrF(indx, 2) - mArrF(k - 1, 2) >= Cells(1, 7) Then
        For c = 1 To 3
            mArrTo(k, c) = mArrF(indx, c)
            mArrTo(k, c) = mArrF(indx, c)
        Next c
        s = True
    End If
    indx = indx + 1
    If s Then
        k = k + 1
        s = False
    End If
Next I

Range("E3").Resize(lr, 3) = mArrTo

xit:
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
Exit Sub
merr:
MsgBox Err.Number & " _ " & Err.Description
Resume xit
End Sub

Application.DisplayAlerts = False

Application.DisplayAlerts = True