' =========== Утилита подготовки стрингов для вставки в .CodeModule =================
Private Sub Get_Code_String()    ' преобразование текстов кодов процедур в стринги
' текст кодов процедур, скопированный в буфер обмена, преобразовать в стринги в соответствии с правилами VBE и поместить в буфер обмена
    Dim sCode$, sText$, sString$
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .GetFromClipBoard: sCode = .GetText: End With    ' получить текст кода процедур из буфера обмена
    sText = Replace(sCode, """", """""")    ' замена " на ""
    sString = """" & Replace(sText, vbCrLf, """ & vbCrLf & _" & vbCrLf & """") & """"    ' замена возвратов каретки на их коды в стринге
    'Debug.Print sText
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText sString: .PutInClipBoard: End With    ' поместить текст стринга в буфер обмена
End Sub

Sub Get_WorkSpace()
   Dim WBk As Workbook, i%
   Dim sFileName$: sFileName = "WorkSpace [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"
   Dim sCode$: sCode = "Private Sub Workbook_Open()" & vbCrLf & _
                       "   Dim rCell As Range" & vbCrLf & _
                       "   For Each rCell In Sheets(1).Range(""a1:a100"")" & vbCrLf & _
                       "      If rCell.Value <> """" Then Workbooks.Open Filename:=rCell.Value" & vbCrLf & _
                       "   Next" & vbCrLf & _
                       "   ThisWorkbook.Close" & vbCrLf & _
                       "End Sub"
   With Application.Workbooks.Add
      For Each WBk In Workbooks
         If Split(WBk.Name, ".")(0) <> "Personal" And WBk.Name <> .Name Then
            .Sheets(1).Cells(i + 1, 1).Value = WBk.FullName: i = i + 1
         End If
      Next WBk
      With .VBProject.VBComponents(1).CodeModule
         .InsertLines .CountOfDeclarationLines + 1, sCode
      End With
   End With
End Sub

Private Sub Save_WorkSpace() '
'---------------------------------------------------------------------------------------
' Procedure    : Save_WorkSpace
' Author       : Alex_ST
' Post_URL     : http://www.excelworld.ru/forum/2-31951-207599-16-1485242663
' DateTime     : 24.01.2017, 10:24
' Purpose      : Сохранение рабочей области
' Notes        : "протез" ампутированной функции Excel-2013
'---------------------------------------------------------------------------------------
   Dim sTitle$: sTitle = "Сохранение рабочей области..."
   If MsgBox("Перед сохранением рабочей области" & vbCr & "необходимо сохранить все открытые файлы Excel." & vbCr & _
             "Сохранить файлы и продолжить?", vbYesNo + vbQuestion, sTitle) = vbNo Then Exit Sub
   Dim sFileName$: sFileName = "WorkSpace (" & Format(Now, "yyyy.mm.dd hh-mm'ss''") & ").xls"
   Dim sCode$: sCode = "Private Sub Workbook_Open()" & vbCrLf & _
                       "   Dim rCell As Range" & vbCrLf & _
                       "   For Each rCell In Sheets(1).Range(""a1:a100"")" & vbCrLf & _
                       "      If rCell.Value <> """" Then Workbooks.Open Filename:=rCell.Value" & vbCrLf & _
                       "   Next" & vbCrLf & _
                       "'   ThisWorkbook.Close" & vbCrLf & _
                       "End Sub"
   Dim WBk As Workbook, i%
   Dim WSWBk As Workbook: Set WSWBk = Application.Workbooks.Add
   With WSWBk
      For Each WBk In Workbooks
         If Not WBk.FullName Like "*\XLSTART\Personal*" And WBk.Name <> .Name Then
            .Sheets(1).Cells(i + 1, 1).Value = WBk.FullName: i = i + 1
            If Not WBk.Saved Then WBk.Save
         End If
      Next WBk
      With .VBProject.VBComponents(1).CodeModule
         .InsertLines .CountOfDeclarationLines + 1, sCode
      End With
   End With
   With Application.FileDialog(msoFileDialogSaveAs)
      .InitialFileName = sFileName: .Title = sTitle: .ButtonName = "Сохранить": .InitialView = msoFileDialogViewLargeIcons
      If .Show = 0 Then Exit Sub     ' если нажали "Отмена", то .Show = 0
      Application.DisplayAlerts = False
      WSWBk.SaveAs FileName:=.SelectedItems(1)
      Application.DisplayAlerts = True
   End With
   'Application.Quit
End Sub