When I run this code from my workbook 'Service Providers' and it has to create a new sheet in the workbook 'Service Provider Historys' I can not get it to disable events in my the workbook 'Service Providers History' and it is also disabling events in the workbook 'Service Providers'. If the code has to create a new sheet in the workbook 'Service Providers History' I want it to disable events in that workbook only and not disable events in the workbook 'Service Providers' : Public Sub ServiceProvidersHistory()

    Application.EnableEvents = False
    Application.ScreenUpdating = Flse
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim historyWB As Workbook
    Dim historyWS As Worksheet
    Dim lastRow As Long
    Dim pasteRow As Long
    
    ' Set source workbook and worksheet
    Set sourceWB = ActiveWorkbook
    Set sourceWS = sourceWB.ActiveSheet
    
    Dim backupNeeded As Boolean
    'backupNeeded = sourceWB.ActiveSheet.Range("J31").Value = ""
    backupNeeded = sourceWB.ActiveSheet.Range("J21").Value = ""
    If backupNeeded Then
        Dim userResponse As VbMsgBoxResult
        userResponse = MsgBox("CURRENT NUMBER OF ENTRIES DO NOT NEED A BACK UP" & vbCrLf & "" & vbCrLf & _
        "Do you still want to back up?", vbQuestion + vbYesNo)
        If userResponse = vbNo Then
            Exit Sub
            End If
            End If
        
    ' Insert today's date in C5 to I5
    Dim currentDate As Date
    currentDate = Date
    ' Unlock Sheet
    sourceWS.Unprotect Password:="edit"
    sourceWS.Range("C5").Value = currentDate
    sourceWS.Range("I5").Value = currentDate
    ' Lock Sheet
    sourceWS.Protect Password:="edit"
   
    ' Find the first empty cell in column I
Dim firstEmptyCell As Range
Set firstEmptyCell = sourceWS.Range("I:I").Find("", LookIn:=xlValues, LookAt:=xlWhole)
Dim dateCell As Range
Set dateCell = firstEmptyCell.Offset(-1, 0)
If Format(dateCell.Value, "dd / mm / yyyy") < Date - 30 Then
    MsgBox "Completed Tasks are recent, wait 30 days before committing to History"
    Application.EnableEvents = True
    Exit Sub
End If

    ' Check if an empty cell is found
    If Not firstEmptyCell Is Nothing Then
        ' Calculate the last row to copy based on the first empty cell in column I
        lastRow = firstEmptyCell.row - 1
    End If

    ' Copy the range from B5 to the last row in L
    sourceWS.Range("B5:L" & lastRow).Copy

    ' Open the history workbook
Dim filePath As String
filePath = ThisWorkbook.Path & "\Service Providers History.xlsb"
Set historyWB = Workbooks.Open(filePath)

    Application.Wait (Now + TimeValue("0:00:15"))
    ' Select the sheet with the same name as the active sheet in the source workbook
    On Error Resume Next
    Set historyWS = historyWB.Sheets(sourceWS.Name)
    On Error GoTo 0
    
    ' Disable events in the 'Service Providers History' workbook
    Workbooks("Service Providers History.xlsb").Application.EnableEvents = False
    
    ' If the sheet doesn't exist, create a new sheet with the same name
    If historyWS Is Nothing Then
    Application.EnableEvents = True
        sourceWS.Copy After:=historyWB.Sheets(historyWB.Sheets.count)
        Set historyWS = historyWB.ActiveSheet
        historyWS.Name = sourceWS.Name
        
     Workbooks("Service Providers History.xlsb").Application.EnableEvents = False
     
'CREATE A NEW SHEET IN HISTORY WITH FORMATING
With sourceWS.Range("B1:L5")
            historyWS.Unprotect Password:="edit"
            historyWS.Range("B1:L5").Value = .Value
            .Copy
            historyWS.Range("B1:L5").PasteSpecial xlPasteFormats
            historyWS.Range("B1:L5").PasteSpecial xlPasteColumnWidths
            historyWS.Columns("A").ClearContents
            historyWS.Buttons.Delete
            historyWS.Columns("A").ColumnWidth = 5
            historyWS.Rows("6:100").Delete
            historyWS.Protect Password:="edit"
        End With
        ' Prompt user and exit sub
        MsgBox "A NEW HISTORY SHEET WAS CREATED" & vbCrLf & "" & vbCrLf & _
        "Check the sheet Format & Strcture" & vbCrLf & "" & vbCrLf & _
        "DELETE THE VBA CODE FROM THE NEW HISTORY SHEET" & vbCrLf & "" & vbCrLf & _
        "Close & Save the History Workbook" & vbCrLf & "" & vbCrLf & _
        "Run the History again to archive records.", vbCritical, "HISTORY SHEET"
    
        Workbooks("Service Providers History.xlsb").Application.EnableEvents = False
        Exit Sub

    End If
    
    ' Activate the history workbook, select the history sheet
    historyWB.Activate
    historyWB.Sheets(sourceWS.Name).Select
    historyWS.Unprotect Password:="edit"
    ' Find the next empty row in the history sheet
    pasteRow = historyWS.Cells(historyWS.Rows.count, "B").End(xlUp).row + 1
    ' Paste the values from the clipboard into the history sheet
    historyWS.Range("B" & pasteRow).PasteSpecial Paste:=xlPasteValues
    
    ' Save and close the history workbook
    historyWB.Save
    historyWB.Close
    
    ' Clear the contents from B6 to the last row in L
    'sourceWS.Range("B6:L" & lastRow).ClearContents
    
' Delete the cells from B6 to the last row in L and move the cells up to row 6
' Unlock Sheet
sourceWS.Unprotect Password:="edit"
    Dim lastCell As Range
    Set lastCell = sourceWS.Range("L" & Rows.count).End(xlUp)
    If lastCell.row > 6 Then
        ''''''''sourceWS.Range("B6:L" & lastCell.Row).Delete Shift:=xlUp
        Dim clearRange As Range
Set clearRange = sourceWS.Range("B6:L" & lastRow)
clearRange.ClearContents
clearRange.Rows.Delete Shift:=xlShiftUp
    End If
    ' Lock Sheet
sourceWS.Protect Password:="edit"
    
    ' Display a message box
    MsgBox "Completed tasks have been backed up to History"
    
    ' Enable all events
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub