Sub GetXLS(ByRef rs, ByVal FilePath$, ByVal sSql$, Optional ByVal FieldsName As Boolean = True)
Dim sCon As String, FieldName As String
Dim cn  As Object
Set cn = CreateObject("ADODB.Connection")
If FieldsName Then FieldName = "Yes" Else FieldName = "No"
Select Case Val(Application.Version)
        Case Is < 12
            sCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath _
              & ";Extended Properties=""Excel 8.0;HDR=" & FieldName & ";IMEX=1"";"
        Case else
            sCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FilePath _
            & ";Extended Properties=""Excel 12.0;HDR=" & FieldName & ";IMEX=1"";"
    End Select
 cn.CursorLocation = 3
cn.Open sCon
Set rs = cn.Execute(sSql)
End Sub

Sub GetSheets()
Dim rs As Object
For i = 1 To Sheets.Count
If Sheets(i).Name <> "свод" Then
sSql = sSql & "  select f1,f2,f3,f4,f5,f6 from [" & Sheets(i).Name & "$] where f1='данные' union all "
End If
Next
sSql = Left(sSql, Len(sSql) - 10)
Call GetXLS(rs, ThisWorkbook.FullName, sSql, False)
Sheets("свод").[a1].CopyFromRecordset rs
End Sub