XL 2010 écran non figé lors d'un calcul long malgré "Application.screenupdating = false"

Sub Test()
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   With Feuil1
      If .Range("a1") = "bidon" Then .Columns(1).Delete
      .Range("a2:a100000").Formula = "=RANDBETWEEN(1,5)"
      .Range("a2:a100000").Value = .Range("a2:a100000").Value
      .Columns(1).Insert: .Range("a1") = "bidon"
      .Range("a2:a100000").FormulaR1C1 = "=IF(RC[1]<=3,NA(),row())"
      .Range("a2:a100000").Value = .Range("a2:a100000").Value
      Intersect(.Range("a2:a100000").EntireRow, .UsedRange).Sort key1:=.Range("a2"), order1:=xlAscending, Header:=xlNo
      On Error Resume Next
      .Range("a2:a100000").SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
      On Error GoTo 0
      If .Range("a1") = "bidon" Then .Columns(1).Delete
   End With
   Application.Calculation = xlCalculationAutomatic
   MsgBox "fini"
End Sub

Option Explicit
Sub Test()
Dim T(), LS As Long, LE As Long, N As Byte, C As Long
ReDim T(1 To 100000, 1 To 1)
   Randomize
   For LS = 1 To 100000
      N = Int(Rnd * 5 + 1)
      If N > 3 Then T(LS, 1) = N
      Next LS
   Feuil1.[A2].Resize(100000).Value = T
   MsgBox "debut suppression vides dans " & Intersect(Feuil1.Columns(1), Feuil1.UsedRange).Address
   With Feuil1.UsedRange
      T = .Value
      LS = 1
      For LE = 2 To UBound(T, 1)
         If Not IsEmpty(T(LE, 1)) Then
            LS = LS + 1
            For C = 1 To UBound(T, 2)
               T(LS, C) = T(LE, C)
               Next C: End If: Next LE
      .ClearContents
      .Resize(LS).Value = T
      End With
   MsgBox "fini"
   End Sub

Sub test2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("A:A").ClearContents
T0 = Timer
Dim tablo()
ReDim tablo(100000)
Indextablo = 0
    For i = 0 To 100000
        N = Application.RandBetween(1, 5)
        If N > 3 Then
            tablo(Indextablo) = N
            Indextablo = Indextablo + 1
        End If
    Next i
ReDim Preserve tablo(Indextablo)
Cells(2, 1).Resize(UBound(tablo)) = Application.Transpose(tablo)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Temps de traitement " & Round(Timer - T0, 3) & "s" & Chr(10) & Indextablo & " nombres générés."
End Sub

Sub Test()
    Dim tablo(), L&, I&, X#

    For I = 1 To 100000
        X = Application.RandBetween(1, 5)
        If X > 3 Then L = L + 1: ReDim Preserve tablo(1 To L): tablo(L) = X
    Next I

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Feuil1.Cells(2, 1).Resize(UBound(tablo), 1) = Application.Transpose(tablo)
    Application.Calculation = xlCalculationAutomatic

    MsgBox "terminé"
End Sub