Next
    sSQL = Join(SheetsNames, " UNION ALL ")
    
    'формируем кэш по таблицам с листов из SheetsNames
    With ActiveWorkbook
        ReDim arSQL(1 To (UBound(SheetsNames) + 1))
        For i = LBound(SheetsNames) To UBound(SheetsNames)
            arSQL(i + 1) = "SELECT * FROM [" & SheetsNames(i) & "$]"
        Next i
        Set objRS = CreateObject("ADODB.Recordset")
        objRS.Open sSQL, Join$(arSQL, " UNION ALL "), _
                   Join$(Array("Provider=Microsoft.Jet.OLEDB.4.0; Data Source=", _
                               .FullName, ";Extended Properties=""Excel 8.0;"""), vbNullString)
    End With

'массив имен листов с исходными таблицами
SheetsNames = Array("a1", "a2", "a3", "a4")

Dim s As String
'Ввод массива имен листов с исходными таблицами
s = InputBox("Имена листов через запятую")
s = Replace(s, ", ", ",")  'Удаляем возможные пробелы после запятой
SheetsNames = Split(s, ",")