Can't turn autocalculate back on.

Hi guys, I am really new to vba. I managed to piece together the below macro but I can't seem to get autocalculate to turn back on and would appreciate some help.

Sub testing()
Application.Calculation = xlCalculationManual
Dim FilesToOpen
   Dim x As Integer
   On Error GoTo ErrHandler
   Application.ScreenUpdating = False
   FilesToOpen = Application.GetOpenFilename _
     (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
     MultiSelect:=True, Title:="Select Short Term")

   If TypeName(FilesToOpen) = "Boolean" Then
       MsgBox "No Files were selected"
       GoTo ExitHandler
   End If
  x = 1
  Dim wkb As Workbook
  Dim wks As Worksheet
  Application.DisplayAlerts = False
  While x <= UBound(FilesToOpen)
      Set wkb = Workbooks.Open(FilesToOpen(x))
      On Error Resume Next
      On Error GoTo ErrHandler
      Cells.Copy
        ThisWorkbook.Activate
        Sheets("Short Term").Activate
        Range("A1").Select
        ActiveSheet.Paste
         wkb.Close False
      x = x + 1
  Wend
  Application.DisplayAlerts = True

   FilesToOpen = Application.GetOpenFilename _
     (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
     MultiSelect:=True, Title:="Select Term")
   If TypeName(FilesToOpen) = "Boolean" Then
       MsgBox "No Files were selected"
       GoTo ExitHandler
   End If
  x = 1
    Application.DisplayAlerts = False
  While x <= UBound(FilesToOpen)
      Set wkb = Workbooks.Open(FilesToOpen(x))
      On Error Resume Next
      On Error GoTo ErrHandler
      Cells.Copy
        ThisWorkbook.Activate
        Sheets("term").Activate
        Range("A1").Select
        ActiveSheet.Paste
         wkb.Close False
      x = x + 1
  Wend
  Application.DisplayAlerts = True
   FilesToOpen = Application.GetOpenFilename _
     (FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
     MultiSelect:=True, Title:="Select GSE-TLGP")
   If TypeName(FilesToOpen) = "Boolean" Then
       MsgBox "No Files were selected"
       GoTo ExitHandler
   End If
  x = 1
    Application.DisplayAlerts = False
  While x <= UBound(FilesToOpen)
      Set wkb = Workbooks.Open(FilesToOpen(x))
      On Error Resume Next
      On Error GoTo ErrHandler
      Cells.Copy
        ThisWorkbook.Activate
        Sheets("GSE-TLGP").Activate
        Range("A1").Select
        ActiveSheet.Paste
         wkb.Close False
      x = x + 1
      Wend
rename

Application.DisplayAlerts = True
ExitHandler:

   Application.ScreenUpdating = True
   Exit Sub
ErrHandler:
   MsgBox Err.Description
   Resume ExitHandler

     On Error GoTo ErrHandler


End Sub

With a recorded macro I get this line.

You add it before End Sub.

Application.Calculation = xlAutomatic

And if you put the code above?

On Error GoTo ErrHandler

I'm not a VBA expert, but the code should work.

If not, wait for other to react.

Maybe a stupid question, but i asked it anyway.

You active a cell with a formula after running the macro?

Excel don't actived the recount itself automaticly.

Please use code tags, OP... thanks.

thanks for the reminder

Originally Posted by thinlizzy

sorry but how?

use the # icon in the reply or edit box... You can edit your fist post, select the macro and press the # button.

thinlizzy,

Welcome to the forum!
Thank you for adding the code tags

As to your question, your code can be condensed to the following:

Sub CopyToSheet(ByVal ws As Worksheet)
    
    Dim wb As Workbook
    Dim i As Long
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select " & ws.Name
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"
        If .Show = False Then Exit Sub
        
        Set wb = ActiveWorkbook
        
        With Application
            .Calculation = xlCalculationManual
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With
        
        For i = 1 To .SelectedItems.Count
            With Workbooks.Open(.SelectedItems(i))
                .Sheets(1).UsedRange.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
                .Close False
            End With
        Next i
        
        With Application
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
        End With
        
    End With
    
End Sub

Then, to use it you would call it from a main sub, feeding it the destination worksheet, like so:

Sub Testing()
    
    Dim ws As Worksheet
    
    For Each ws In Sheets(Array("Short Term", "Term", "GSE-TLGP"))
        CopyToSheet ws
    Next ws
    
End Sub

You could put the application disable/enable items in the Testing sub instead of the CopyToSheet sub. You will still get a slowdown while the formulas are recalculated, but this way they won't get recalculated until after all sheets have been copied over, instead of being recalculated in between sheet copies per destination sheet.

Sub CopyToSheet(ByVal ws As Worksheet)
    
    Dim wb As Workbook
    Dim i As Long
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Select " & ws.Name
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls*"
        If .Show = False Then Exit Sub
        
        Set wb = ActiveWorkbook
        
        For i = 1 To .SelectedItems.Count
            With Workbooks.Open(.SelectedItems(i))
                .Sheets(1).UsedRange.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
                .Close False
            End With
        Next i
        
    End With
    
End Sub

Sub Testing()
    
    Dim ws As Worksheet
    
    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    For Each ws In Sheets(Array("Short Term", "Term", "GSE-TLGP"))
        CopyToSheet ws
    Next ws
    
    With Application
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
End Sub

Here's a cleaned up version of the Rename sub:

Sub Rename()
    
    Dim myRng As Range
    Dim BlankCell As Range
    
    With Sheets("GSE-TLGP").Cells
        .Replace "TLGP *******", "TLGP"
        .Replace "Citigroup Inc. (HC)", "TLGP"
        .Replace "Sallie Mae", "Federal Farm Credit"
    End With
    
    On Error Resume Next
    Set myRng = Sheets("Short Term").Range("A15:A250").SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If myRng Is Nothing Then Exit Sub
    
    For Each BlankCell In myRng
        BlankCell.Value = BlankCell.Offset(-1, 0).Value
        If BlankCell.Value = "Total" Then Exit For
    Next BlankCell
    
End Sub

Now, in the Testing sub, put Rename just after the "Next ws" line:

    For Each ws In Sheets(Array("Short Term", "Term", "GSE-TLGP"))
        CopyToSheet ws
    Next ws
    
    Rename

You're very welcome