Private Sub Workbook_Open()
       update
End Sub

Option Explicit

Sub update()
       Dim sh As Worksheet, i&, a()

       Application.ScreenUpdating = False

       Sheets(1).UsedRange.Offset(1).Clear

       Set sh = Sheets.Add(, Sheets(Sheets.Count))
          
       With sh
           For i = 1 To 7
               With .QueryTables.Add(Connection:=Array( _
                      "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=D:\TMP\3\КоТъ\" & i & ".xlsx;Mode=Share Deny Write;Extended Proper" _
                      , _
                      "ties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;" _
                      , _
                      "Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Databas" _
                      , _
                      "e Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=Fal" _
                      , "se;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), _
                      Destination:=sh.Range("A1"))
                   .CommandType = xlCmdTable
                   .CommandText = Array("Лист1$")
                   .Name = "1"
                   .FieldNames = True
                   .RowNumbers = False
                   .FillAdjacentFormulas = False
                   .PreserveFormatting = True
                   .RefreshOnFileOpen = False
                   .BackgroundQuery = True
                   .RefreshStyle = xlInsertDeleteCells
                   .SavePassword = False
                   .SaveData = True
                   .AdjustColumnWidth = True
                   .RefreshPeriod = 0
                   .PreserveColumnInfo = True
                   .Refresh BackgroundQuery:=False
               End With

               With sh
                   a = Range(.[h4], .[c3].End(xlDown)).Value
                   .UsedRange.ClearContents
               End With
               With Worksheets(1)
                   .Cells(.Rows.Count, "B").End(xlUp)(2).Resize(UBound(a), 6).Value = a
               End With

           Next
       End With

       Application.DisplayAlerts = False
       sh.Delete
       Application.DisplayAlerts = True
       Application.ScreenUpdating = True
          
End Sub