Код:

Sub Insert_Into_Values_Excel_Sheet()
    Dim MyConnect As New Connection, GetSQL As String, result, cmd As New ADODB.Command
    Dim MySQL As String, i, FSO As FileDialog
    Dim mySh As Worksheet, ClientSH As Worksheet
    Dim Name, Phone, Mail, Site
    Dim DataRange, Clrange, wbToPaste As Workbook, Data
    Set ClientSH = ActiveWorkbook.Worksheets("Sheet1")
    Clrange = GetRange(ActiveWorkbook, ClientSH.Name)
    GetSQL = "[" & ActiveWorkbook.FullName & "]." & Clrange

    Set FSO = Application.FileDialog(msoFileDialogFilePicker)
    FSO.AllowMultiSelect = False
    FSO.Title = "Выберите файл глобального реестра"
    FSO.Show
    
With ActiveWorkbook.Worksheets("Sheet1")
      MyConnect.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
           "Data Source=" & FSO.SelectedItems(1) & ";" & _
           "Extended Properties=""Excel 12.0 Xml;HDR=YES"""
    Data = "[Data$]"
        MySQL = "UPDATE " & Data & " SET [контакты]=dLOOKUP(""[контакты]"", ""[Sheet1$A1:B6]"", ""[Объект]=12"")  WHERE [Объект]=12"
        Debug.Print MySQL
        cmd.ActiveConnection = MyConnect
        cmd.CommandType = adCmdText
        cmd.CommandText = MySQL
        cmd.Execute
        
    End With
    wbToPaste.Close True
    MyConnect.Close
    Set cmd = Nothing
    Set MyConnect = Nothing
End Sub