Private WithEvents qt As QueryTable
Private Sub ss()
    Set qt = [Консолидация].ListObject.QueryTable
    qt.Connection = "OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Mode=Read;Extended Properties=text;Data Source=" & Me.path
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    ss
End Sub
Private Sub Workbook_Open()
    ss
End Sub
Private Sub qt_BeforeRefresh(Cancel As Boolean)
    Dim Command$()
    Dim f$, s$, v&
    f = Me.path:
    s = Dir$(f & "\*.xls*")
    Do
        If Not s Like "~$*" And s <> Me.Name Then
            ReDim Preserve Command(v):
            Command$(v) = Application.Text$(s, _
                """select *,'""@""' From [Лист1$] IN '" & _
                f & "\""@""' [excel 12.0 xml;HDR=No]""")
                v = v + 1
        End If
        s = Dir$()
    Loop While s <> ""
    qt.CommandText = Join(Command, " union all ")
    DoEvents
End Sub