Sub AllForm()
 Application.Visible = True
 Do
  fileToOpen = Application.GetOpenFilename(FileFilter:="XLS Files (*.xls),*.xls", MultiSelect:=True, _
    Title:="Выберите файлы (используя клавиши <Ctrl> или <Shift>) или нажмите 'Отмена'")
  If IsArray(fileToOpen) Then
    MSGText = ""
    For I = LBound(fileToOpen) To UBound(fileToOpen)
      Application.EnableEvents = False
      Workbooks.Open (fileToOpen(I))
      Application.EnableEvents = True

  On Error Resume Next
      ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("TabProcN")
  On Error GoTo  0 
      S = ThisWorkbook.VBProject.VBComponents("TabProcN").CodeModule.Lines( 1 , _
        ThisWorkbook.VBProject.VBComponents("TabProcN").CodeModule.CountOfLines)
      Set X = ActiveWorkbook.VBProject.VBComponents.Add( 1 )
      X.Name = "TabProcN"
      X.CodeModule.AddFromString S
      ActiveWorkbook.Save
      ActiveWorkbook.Close
      MSGText = MSGText & Chr( 10 ) & Chr( 13 ) & fileToOpen(I)
    Next I
    MsgBox "Обновлены файлы:" & MSGText
  End If
 Loop Until Not IsArray(fileToOpen)
 ThisWorkbook.Close
End Sub