The object invoked has disconnected from its clients

[rfletcher35]

Here is my code and has been working fine at the point it is now failing (in Bold). For some reason I am now getting the error message "The object invoked has disconnected from its clients" can someone please tell me why this is happening.

Once this has occurred it also crashes my workbook to which none of my VBA works and I have to use task manager to close and then re open it!

Help please!!!!

Sub Results()
'
' Results Macro
'
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Sheets("SAP Abence").Visible = True
    Sheets("MPR Data").Visible = True
    Sheets("Sheet3").Visible = True
    
    Dim rng365 As Range
    Dim CurMonth As Range
    
    Sheets("Results Sheet").Select
    Range("P5:BL3000").Select
    Selection.ClearContents
    
'   365 - 1 Year of Work No Absence
    Set CurMonth = Range("C2")
    With Sheets("MPR Data")
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="None", Operator:=xlFilterValues
    On Error GoTo Enditall
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("P5").PasteSpecial Paste:=xlPasteValues
Enditall:
    
End If
    Application.CutCopyMode = False
    
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=365", Operator:=xlFilterValues
    On Error GoTo Enditall1
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
Enditall1:
End If
    
'   1 Month to Go
   ' Dim OneMonth As Range
    Sheets("MPR Data").Select
    Set CurMonth = Range("I2")
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:="None", Operator:=xlFilterValues
    On Error GoTo Enditall2
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
End With
If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("AB5").PasteSpecial Paste:=xlPasteValues
    
Enditall2:
End If
    
    With Sheets("MPR Data")
    .Range("$T$4:$AB$3150").AutoFilter Field:=6
    .Range("$T$4:$AB$3150").AutoFilter Field:=1
    .Range("$T$4:$AD$4000").AutoFilter Field:=6, Criteria1:=CurMonth.Value, Operator:=xlFilterValues
    .Range("$T$4:$AD$4000").AutoFilter Field:=1, Criteria1:=">=365", Operator:=xlFilterValues
    On Error GoTo Enditall3
    Set rng365 = .Range("T5:AD4000").SpecialCells(xlCellTypeVisible)
    
End With
    If Not rng365 Is Nothing Then
    rng365.Copy
    Sheets("Results Sheet").Range("AB" & Rows.Count).End(xlUp).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Enditall3:
        
End If
    Sheets("MPR Data").Select
    ActiveSheet.Range("$T$4:$AB$3150").AutoFilter Field:=6
    ActiveSheet.Range("$T$4:$AB$3150").AutoFilter Field:=1
    Sheets("Results Sheet").Select
    
    Range("A1").Select
    
    Sheets("SAP Abence").Visible = False
    Sheets("MPR Data").Visible = False
    Sheets("Sheet3").Visible = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
            
End Sub

 

[rfletcher35]

Where how?

 

[RoryA]

On a sharing site like OneDrive or Dropbox.

 

[rfletcher35]

Where, how?