Loop speed improvement

Question

I am looking for help in improving the speed of this Macro. It is part of a much larger macro, but after testing each part of it individually this section takes up 98% of the time. Total this macro takes about 25-30 minutes. There are only 12 sheets in the workbook. Each sheet has about 200 rows and 50 columns, not that it should matter much with this piece of code. I am not sure if there is better way to do this or if you have any insights to why it is taking so long.

I am running Excel 2016 64bit on an intel I5-6300U CPU @ 2.4Ghz, turbo up to 3Ghz. While running this marco I am hitting around 2.85Ghz with no other programs running. 8GB of RAM.

Sub step3()

Dim sht As Worksheet

Application.ScreenUpdating = False

For Each sht In ActiveWorkbook.Worksheets

    If sht.Name <> "Directions" Then
        'Update months in colA
        sht.Range("A5").Formula = "=EOMONTH(TODAY(),-1)"
        sht.Range("A6").Formula = "=EOMONTH(TODAY(),-2)"
        sht.Range("A7").Formula = "=EOMONTH(TODAY(),-3)"
        sht.Range("A5:A7").Copy
        sht.Range("A5:A7").PasteSpecial xlPasteValues
    End If

Next sht

Application.ScreenUpdating = True
End Sub

Answer 1

turn off calculations and events, something outside the code is causing the issue.

Sub step3()
    On Error GoTo safeout
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim sht As Worksheet
    For Each sht In ActiveWorkbook.Worksheets

        If sht.Name <> "Directions" Then
            With sht.Range("A5:A7")
                .Formula = "=EOMONTH(TODAY(),-ROW(1:1))"
                .Value = .Value
            End With
        End If

    Next sht
safeout:
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
    Application.EnableEvents = True
End Sub