Try this

Code:
Sub CloseAllOtherWorkbooks()
'
' CloseAllOtherWorkbooks Macro
' Keep this workbook open and close all other workbooks in this instance
'
' Keyboard Shortcut: Ctrl+q
'
    Dim wbk As Workbook
    Dim strBookNames() As String
    Dim lngBooksCount As Long
    
    For Each wbk In Application.Workbooks
        If wbk.Name <> ThisWorkbook.Name Then
            lngBooksCount = lngBooksCount + 1
            ReDim Preserve strBookNames(1 To lngBooksCount)
            strBookNames(lngBooksCount) = wbk.Name
        End If
    Next wbk
    For lngBooksCount = 1 To lngBooksCount
        'Change to True if the files have to be saved before closing
        Workbooks(strBookNames(lngBooksCount)).Close False
    Next lngBooksCount
    Set wbk = Nothing
    Erase strBookNames
    
End Sub