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




Reply With Quote

Bookmarks