Please correct my mfggn code to make it faster/more effecient

[ammartino44]

Hello. COUld some kind soul take the time to read through my code and give me tips on how to improve it. Right now, it runs kind of slow and I want to be sure I'm being correct/efficient. Thank ye, thank ye.

Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
Dim sh As Worksheet, wb As Workbook



MyFolder = "C:\Users\amartino\Desktop\Test"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
If LCase(MyFile) <> "template.xlsx" Then
    Workbooks.Open Filename:=MyFolder & "\" & MyFile
    
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

ActiveWorkbook.Sheets(1).Name = "GL"
ActiveWorkbook.Sheets("GL").Range("A:B,G:P").EntireColumn.Delete
Lastrow = Range("D" & Rows.Count).End(xlUp).Row
Worksheets("GL").Range("E2:E" & Lastrow).Formula = "=IF(LEFT(A2,1)=""3"",(D2-C2),IF(OR(LEFT(A2,1)=""4"",Left(A2,1)=""5""),(C2-D2),0))"

Sheets("GL").Columns("E").Copy
Sheets("GL").Columns("E").PasteSpecial xlPasteValues
Worksheets("GL").Columns("C:D").EntireColumn.Delete

Application.DisplayAlerts = False
vaNames = Array("Sheet2", "Sheet3")
Worksheets(vaNames).Delete
Application.DisplayAlerts = True

Set wb = ActiveWorkbook
For Each WS In Workbooks("template").Worksheets
If WS.Name <> "GL" Then
WS.Copy After:=wb.Sheets(wb.Sheets.Count)
End If
Next WS

fnd = "[template.xlsm]"
rplc = ""

For Each sht In ActiveWorkbook.Worksheets
  sht.Cells.Replace What:=fnd, Replacement:=rplc, _
    LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
    SearchFormat:=False, ReplaceFormat:=False
Next sht



Sheets("Code List").Select
b = "A2" 'specified by you
e = Range("A1").End(xlDown).Address 'get's address of the last used cell
 'loops through cells,creating new sheets and renaming them based on the cell value

For Each cell In Range(b, e)
If Left(cell, 1) = 0 Then
 s = Sheets.Count
 Sheets("I&E2").Copy After:=Sheets(s)
ActiveSheet.Name = cell.Value
ActiveSheet.Calculate

Set wks = ActiveSheet

  With wks.Cells.SpecialCells(xlCellTypeFormulas)
    Set cell = .Find(What:="SUMIF(", LookIn:=xlFormulas, LookAt:=xlPart)
    Do While Not cell Is Nothing
      cell.Value2 = cell.Value2
      Set cell = .FindNext(cell)
    Loop
  End With

Else:

s = Sheets.Count
 Sheets("I&E").Copy After:=Sheets(s)
ActiveSheet.Name = cell.Value
ActiveSheet.Calculate

Set wks = ActiveSheet

  With wks.Cells.SpecialCells(xlCellTypeFormulas)
    Set cell = .Find(What:="SUMIF(", LookIn:=xlFormulas, LookAt:=xlPart)
    Do While Not cell Is Nothing
      cell.Value2 = cell.Value2
      Set cell = .FindNext(cell)
    Loop
  End With

End If
Next

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Totals"
Worksheets("I&E").Range("A:B").Copy
Worksheets("Totals").Paste
  
Last_Row = Worksheets("Code List").Range("B" & Rows.Count).End(xlUp).Row
Set CurrRange = Worksheets("Code List").Range("B1:B" & Last_Row)
                CurrRange.AutoFilter Field:=1, Criteria1:="<>0*"
                CurrRange.SpecialCells(xlCellTypeVisible).Copy
Sheets("Totals").Range("B5").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
                CurrRange.AutoFilter


Dim i As Long: i = 3

For iCurWS = 11 To Worksheets.Count - 1
    Set WS = Sheets(iCurWS)
    With WS
        Last_Row = .Range("BC" & Rows.Count).End(xlUp).Row
        .Range("BC6:BC" & Last_Row).Copy
        Sheets("Totals").Cells(6, i).PasteSpecial _
            Paste:=xlPasteValues, _
            Operation:=xlNone, _
            SkipBlanks:=False
        i = i + 1
    End With 'WS
Next

Set sht = ActiveWorkbook.Worksheets("Totals")
Lastcolumn = sht.Cells(5, sht.Columns.Count).End(xlToLeft).Column
sht.Cells(5, Lastcolumn).Value = "Sum"

With Range("A:A")
    With Range(.Cells(Rows.Count, 1).End(xlUp), .Parent.Cells.Find("Sum").Offset(1, 0))
    .Columns(.Columns.Count).FormulaR1C1 = "=SUM(RC3:RC[-1])"
    End With
End With

End If
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub