Sub plusOn()
  Dim shtF As Worksheet
  Set shtF = ThisWorkbook.Sheets("Функции")
  
  If ObjectName.ActiveCell.Value = "+" Then
    shtF.Range("E1").Value = ObjectName.ActiveCell.Offset(0, -2).Value
    shtF.Range("E2").Value = ObjectName.ActiveCell.Offset(0, -1).Value
  Else
    Exit Sub
  End If
  
  'и тд...
End Sub

Sub importPrescriptsWithControl()
   Dim sFile, sPath, sFileName, sFolder
   Dim idPreCon As Long
   Dim rst As Recordset
   Dim fd As FileDialog
   Dim appExcel As Object
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
   With fd
      If .Show = False Then Exit Sub
      .AllowMultiSelect = False
      sFolder = .SelectedItems(1)
   End With
   
   sPath = sFolder & "\" & "*.xlsm"
   sFile = Dir(sPath)
   sFileName = sFolder & "\" & sFile
  
  Set appExcel = CreateObject("excel.application")
    Do While sFile <> ""
       appExcel.Workbooks.Open (sFileName)
      idPreCon = appExcel.Worksheets("Функции").Range("R57").Value
      Set rst = CurrentDb.OpenRecordset("SELECT * FROM tPrescripts WHERE idPrescript = " & CStr(idPreCon))
      appExcel.ActiveWorkbook.Close False '!!!! ЗАВИСАЛ ТУТ !!!!
      appExcel.Quit
      
      If rst.RecordCount = 0 Then
        MsgBox "вставка"
      Else
        MsgBox "уже есть"
      End If
    Loop
End Sub

Dim wbkExcel As Excel.Workbook

Option Compare Database
Option Explicit
Sub importTEST()
   Dim sFile, sPath, sFileName, sFolder
   Dim idPreCon As Long
   Dim rst As Recordset
   Dim fd As FileDialog
   Dim appExcel As Object
   Dim wbkExcel 'As Excel.Workbook или As Workbook - на это ругается!
  
   Set fd = Application.FileDialog(msoFileDialogFolderPicker)
   
   With fd
      If .Show = False Then Exit Sub
      .AllowMultiSelect = False
      sFolder = .SelectedItems(1)
   End With
   
   sPath = sFolder & "\" & "*.xlsm"
   sFile = Dir(sPath)
   sFileName = sFolder & "\" & sFile
  
  Set appExcel = CreateObject("excel.application")
    Do While sFile <> ""
      Set wbkExcel = appExcel.Workbooks.Open(sFileName)
      idPreCon = wbkExcel.Worksheets("Функции").Range("R57").Value
      'Set wbkExcel = Nothing 'Но можно и без этого
      Set rst = CurrentDb.OpenRecordset("SELECT * FROM tPrescripts WHERE idPrescript = " & CStr(idPreCon))
      wbkExcel.Close False
      
        If rst.RecordCount = 0 Then
        'импорт с первого листа
          Call DoCmd.TransferSpreadsheet(acImport, acSpreadsheetTypeExcel12, _
              "tPrescripts", sFileName, True, "requisites")
        'аналогичный импорт со второго листа ...
        'аналогичный импорт с третьего листа ...
        Else
          MsgBox "уже есть"
        End If
        
      sFile = Dir
    Loop
  appExcel.Quit
  
End Sub