sub auto_otkr()
shell "excel.exe c:\book1.xlsm" 'путь к файлу
end sub

Public Sub test()
    Dim wb As Workbook
    Set wb = GetObject("Источник CRM")
    Debug.Print wb.FullName
End Sub

Private Declare Function AccessibleObjectFromWindow& Lib "oleacc.dll" _
               (ByVal Hwnd&, _
                ByVal dwId&, _
                riid As GUID, _
                xlwb As Object)
 Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
                                     (ByVal hWnd1 As Long, _
                                      ByVal hWnd2 As Long, _
                                      ByVal lpsz1 As String, _
                                      ByVal lpsz2 As String) _
                                      As Long
 
    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal Hwnd As Long, ByVal wMsg As Integer, _
ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    Declare Function ShowWindow Lib "user32" _
(ByVal Hwnd As Long, ByVal y As Integer) As Boolean
 
Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
 
End Type
Private Sub SetGUID(ByRef ID As GUID, Optional VerRus As Boolean = True)
If VerRus Then
 
 
With ID
        .Data1 = &H20400
        .Data2 = &H0
        .Data3 = &H0
        .Data4(0) = &HC0
        .Data4(1) = &H0
        .Data4(2) = &H0
        .Data4(3) = &H0
        .Data4(4) = &H0
        .Data4(5) = &H0
        .Data4(6) = &H0
        .Data4(7) = &H46
 
    End With
 
Else
 
 
With ID
        .Data1 = &H90140000
        .Data2 = &H16
        .Data3 = &H409
        .Data4(0) = &H0
        .Data4(1) = &H0
        .Data4(2) = &H0
        .Data4(3) = &H0
        .Data4(4) = &H0
        .Data4(5) = &HF
        .Data4(6) = &HF1
        .Data4(7) = &HCE
 
    End With
  End If
End Sub
    Sub XLref()
    
     Dim xl As Excel.Application
        Dim ob As Object
        Dim XLMAIN, XLDESK, EXCEL7 As Long
        Dim G As GUID
        SetGUID G
        XLMAIN = FindWindowEx(0, 0, "XLMAIN", vbNullString)
        While XLMAIN <> 0
            XLDESK = FindWindowEx(XLMAIN, 0, "XLDESK", vbNullString)
            EXCEL7 = FindWindowEx(XLDESK, 0, "EXCEL7", vbNullString)
            If EXCEL7 <> 0 Then
                ShowWindow XLMAIN, 8
                 ShowWindow XLDESK, 8 'SW_SHOWNA=8
                AccessibleObjectFromWindow EXCEL7, &HFFFFFFF0, G, ob
              Set xl = ob.Application
        For Each Wb In xl.Workbooks
            Debug.Print Wb.Name
        Next Wb
                           
            End If
            XLMAIN = FindWindowEx(0, XLMAIN, "XLMAIN", vbNullString)
        Wend
            
    End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

      If Not Intersect(Range("A:N"), Target) Is Nothing Then
        If Not xl Is Nothing Then Cancel = True: KopyrovatZanchenie Target, xl
    End If
End Sub

Public xl As Application

Sub test()

    Dim newWB As Workbook
    Set xl = New Application
    Set newWB = xl.Workbooks.Open("D:\Omben2.xlsm")
    With xl.Application
        .Visible = True: .WindowState = xlNormal
        .Top = 130: .Left = 500: .Width = 240: .Height = 240
    End With  

Sub KopyrovatZanchenie(ByRef cell As Range, ap As Application)

    Dim sh As Worksheet: Set sh = ap.Workbooks("Omben2.xlsm").Worksheets("Filtr")
    Range("a1").Resize(30, 1).Copy
    sh.Range("a1").PasteSpecial paste:=xlPasteValues
End Sub

Workbooks.Add
Application.Run "'рабочийфайл'!макрос"

sub auto_otkr()
shell "excel.exe c:\book1.xlsm" 'путь к файлу
end sub