XL 2019 Optimisation VBA

Bonjour,

J'aurais besoin de votre aide pour optimiser mon code VBA.
A noter que j'utilise beaucoup les formules dans le fichier. Le temps d'exécution est de 85 secondes.
Pouvez-vous m'aider à améliorer d'avantage ce code..

Dans l'attente de vos retours..

Ci-dessous le code

Sub LNMME()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim fin As Long
Dim fin1 As Long
Dim timerdebut As Double
Dim nbf As Integer
Dim calcState As Long



calcState = Application.Calculation



With ThisWorkbook.Worksheets("LNMME").AutoFilter.Filters
For nbf = 1 To .Count
If .Item(nbf).On Then ThisWorkbook.Worksheets("LNMME").ShowAllData: Exit For
Next nbf
End With

fin = Range("K" & Rows.Count).End(xlUp).Row

timerdebut = Timer
'
'supprimer le contenu à partir de la 3ème ligne

Range("A3").CurrentRegion.Offset(2).Resize(Range("A3").CurrentRegion.Rows.Count - 2).ClearContents

' Copy dans les données de la feuil3 et coller dans la feuille active

Sheets(2).Range("A2").CurrentRegion.Offset(1).Copy Range("A3")

' calcule des données pour la prise des formules

Range("H2:K2").AutoFill Destination:=Range("H2:K" & fin)
ActiveSheet.Calculate

' Supprimer la premiere ligne
Range("A2").CurrentRegion.Rows(2).Delete

'filtre LNMME NOK

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=11, Criteria1:= _
"LNMME_NOK"


MsgBox "Durée : " & (Timer - timerdebut) & " sec."

Application.Calculation = calcState


End Sub