Фрагмент процедуры:  
 
Sub ImportDATA()  
 Dim Replica As Variant, CurrentSheet As String, NameSheet As String  
 Dim TempOfString As String, j As Integer  
 Dim LastRowSource As Integer, RowTarget As Integer  
 Dim TempOfRange As Range, StartColumnSource As Integer  
 Dim StartRowSource As Integer, Cell As Variant  
 Application.Calculation = xlManual  
  CurrentSheet = "Текущий"  
 Replica = MsgBox("Файл с данными уже открыт?", Buttons:=vbYesNo + vbQuestion + vbDefaultButton1)  
    Select Case Replica  
           Case Is = vbNo  
              Dim FD As FileDialog  
              Dim iFileName As String  
              Dim Book As Workbook  
              Dim CheckNameBook As String  
     
              Set FD = Application.FileDialog(msoFileDialogFilePicker)  
       With FD  
             .Filters.Clear  
             .Filters.Add "Microsoft Excel files", "*.xls"  
             .Filters.Add "All files", "*.*"  
             .AllowMultiSelect = False  
             .InitialFileName = ThisWorkbook.path  
             .Title = "Открытие документа"  
             .ButtonName = "Открыть"  
            If .Show = False Then  
               MsgBox "Вы не указали файл-источник!", 48, "Îøèáêà"  
               Exit Sub  
            Else  
               iFileName = .SelectedItems(1)  
            End If  
         End With  
         Set FD = Nothing  
         CheckNameBook = GetWorkbookName(iFileName)  
          ‘проверка открыт ли выбранный файл  
         If WorkbooksOpen(CheckNameBook) = False Then  
           Set Book = Workbooks.Open(FileName:=iFileName, UpdateLinks:=False)  
         Else  
           Replica = MsgBox("Файл с именем `" & CheckNameBook & "` уже открыт. Продолжить?", Buttons:=vbYesNo + vbQuestion + vbDefaultButton1)  
           Select Case Replica  
             Case Is = vbNo  
              MsgBox "Копирование прервано пользователем", 48, "Ошибка"  
               Exit Sub  
             Case Is = vbYes  
              Set Book = Workbooks(CheckNameBook)  
           End Select  
          End If  
       Case Is = vbYes  
           ChoiseBook.Show  
              If SelectName <> "" Then  
                Set Book = Workbooks(SelectName)  
              Else  
                MsgBox "Вы не выбрали имя книги!", 48, "Ошибка"  
                 Exit Sub  
              End If  
     End Select  
Function GetWorkbookName(wbPathName As String) As String  
‘Возвращает имя книги из полного маршрута  
Dim Position As Integer  
Position = CountSimbol(wbPathName, "\")  
GetWorkbookName = Substring(wbPathName, "\", Position + 1)  
End Function  
Function WorkbooksOpen(WorkbooksName As String) As Boolean  
'Возвращает ИСТИНА,  если рабочая книга открыта  
Dim Book As Workbook  
On Error Resume Next  
Set Book = Workbooks(WorkbooksName)  
If Err = 0 Then WorkbooksOpen = True _  
Else WorkbooksOpen = False  
End Function  
 
Формы ChoiseBook и ChoiseList в прилагаемом файле.