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
Bookmarks