XL 2016 Optimiser macro

[KTM]

Bonjour chers tous
J'ai une macro qui prend en compte 50 feuilles ( 51 à 100 ). Pour dire vrai elle fonctionne mais compte tenu du volume de travail qu'elle doit faire je trouve une lenteur dans l’exécution.
Existerait-il un autre procédé pour vite faire ou comment puis-je l'optimiser? Merci

Sub Reinitialiser()
Dim i As Long, T
Application.ScreenUpdating = False
    T = Array(51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, _
    70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100)
For i = LBound(T) To UBound(T)
       With Worksheets(T(i))
             .Range("C243").Value = .Range("C247").Value
             .Range("D10:D240").Value = .Range("I10:I240").Value
             .Range("L10:L240").Value = .Range("K10:K240").Value
             .Range("K10:K240").Value = .Range("F10:F240").Value
            
            For Each cel In .Range("D10:D240,K10:L240")
If IsNumeric(CStr(cel)) Then cel.FormulaLocal = "=" & cel Else cel.Formula = "=""" & cel & """"
            Next cel
           .Range("G3:I3,F10:H240,J10:J240") = ""
           End If
           End With
Next i
Application.ScreenUpdating = True
End Sub

 

[pierrejean]

Bonjour KTM
A tester
remplacer

For Each cel In .Range("D10:D240,K10:L240")
    If IsNumeric(CStr(cel)) Then cel.FormulaLocal = "=" & cel Else cel.Formula = "=""" & cel & """"
Next cel

par

t1 = .Range("D10:D240")
t2 = .Range("K10:L240")
For n = LBound(t1, 1) To UBound(t1, 1)
  If IsNumeric(t1(n, 1)) Then
      t1(n, 1) = "=" & t1(n, 1)
  Else
       t1(n, 1) = "=""" & t1(n, 1) & """"
  End If
Next
.Range("D10:D240") = t1
For n = LBound(t2, 1) To UBound(t2, 1)
  For m = LBound(t2, 2) To UBound(t2, 2)
  If IsNumeric(t1(n, 1)) Then
      t2(n, m) = "=" & t2(n, m)
  Else
       t2(n, m) = "=""" & t2(n, m) & """"
  End If
Next
Next
.Range("K10:L240") = t2

 

[jmfmarques]

Bonjour
J'observe que les remarques au demeurant judicieuses faites à propos de l'utilisation abusive d'un array de ce type (https://www.excel-downloads.com/threads/figer-les-volets.20045534/)
sont restées purement et simplement lettre morte.

 

[KTM]

Bonjour KTM
A tester
remplacer

For Each cel In .Range("D10:D240,K10:L240")
    If IsNumeric(CStr(cel)) Then cel.FormulaLocal = "=" & cel Else cel.Formula = "=""" & cel & """"
Next cel

par

t1 = .Range("D10:D240")
t2 = .Range("K10:L240")
For n = LBound(t1, 1) To UBound(t1, 1)
  If IsNumeric(t1(n, 1)) Then
      t1(n, 1) = "=" & t1(n, 1)
  Else
       t1(n, 1) = "=""" & t1(n, 1) & """"
  End If
Next
.Range("D10:D240") = t1
For n = LBound(t2, 1) To UBound(t2, 1)
  For m = LBound(t2, 2) To UBound(t2, 2)
  If IsNumeric(t1(n, 1)) Then
      t2(n, m) = "=" & t2(n, m)
  Else
       t2(n, m) = "=""" & t2(n, m) & """"
  End If
Next
Next
.Range("K10:L240") = t2

OK merci