Private Sub Workbook_BeforeClose(Cancel As Boolean)
…
If Cells(1, 1) = "" And Workbooks.Count = 1 Then MsgBox "1": ThisWorkbook.Close (False): MsgBox "2": Application.Quit
MsgBox "3"
…

Private Sub Workbook_BeforeClose(Cancel As Boolean, k As Byte)
…
With Range("E2:E" & lr + 8)
…
    .ClearContents
End With

ThisWorkbook.Save
If Workbooks.Count = 1 Then MsgBox "Quit " & k: k = k + 1: Application.Quit
End Sub

ThisWorkbook.Close False

Sub Test2()
    MsgBox 1
    Application.DisplayAlerts = False
    Application.Quit
    MsgBox 2
    DoEvents
    MsgBox 3
    Stop
End Sub

Option Explicit
#If Win64 Then
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" ( _
                    ByVal hwnd As Long, _
                    lpdwProcessId As Long) As Long
#Else
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
#End If

Function KillProcess(hwnd As Long)
    Dim CurrentForegroundThreadID As Long
    Dim strComputer As String
    Dim objWMIService
    Dim colProcessList
    Dim objProcess
    Dim ProcIdXL As Long
    
    ProcIdXL = 0
    CurrentForegroundThreadID = GetWindowThreadProcessId(hwnd, ProcIdXL)
    If ProcIdXL = 0 Then Exit Function    '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    
    strComputer = "."
    
    Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where ProcessID =" & ProcIdXL)
    For Each objProcess In colProcessList
      objProcess.Terminate
    Next
End Function

Sub KillMe()
    KillProcess Application.hwnd
End Sub

Sub Test2()
    MsgBox 1
    Application.DisplayAlerts = False
    KillMe  'Application.Quit
    MsgBox 2    
    MsgBox 3
End Sub