Sub CombineDataViaQT()
Dim arDataSheetNames() As String
Dim arSQL_Elements() As String
Dim i As Long, j As Long
Dim lWhichOne As Long
Dim sConn As String
Dim sSQL As String
Dim sSQL_SELECT As String
Dim sSQL_FROM As String
Dim sSQL_UNION_ALL As String
Dim wbkNew As Workbook
Application.ScreenUpdating = False
With ThisWorkbook
'Assumes sheets named "after here" & "before here" with data sheets in between.
ReDim arDataSheetNames(1 To .Worksheets("before here").Index - .Worksheets("after here").Index - 1)
'Each worksheet has one data table and each contributes 3 elements to the SQL, except
'the first data table which has 2 elements only. [SQL construct "SELECT * FROM tbl1"
'for the first file and then the three elements for each other worksheet,
'"UNION ALL SELECT * FROM tb2", etc.]
ReDim arSQL_Elements(1 To 3 * UBound(arDataSheetNames) - 1)
'Use new counter to simplify references. The data worksheet indices don't start
'at 1 because they aren't the first worksheets and this is one way to get the
'required references within the loop just below.
lWhichOne = 0
'Loop through worksheets
For i = .Worksheets("after here").Index + 1 To .Worksheets("before here").Index - 1
lWhichOne = lWhichOne + 1
'Load data worksheet names to an array for use when creating the SQL
arDataSheetNames(lWhichOne) = .Worksheets(i).Name
'Assign named ranges to data ranges
.Worksheets(i).Range("A1").CurrentRegion.Name = "tbl" & lWhichOne
Next i
'Connection for query
sConn = Join$(Array("ODBC;DSN=Excel Files;DBQ=", .FullName, ";DefaultDir=", _
.Path, ";DriverID=790;MaxBufferSize=2048;PageTimeout=5;"), vbNullString)
End With
'Generate SQL, in two steps
'First the combination from the multiple sheets
sSQL_SELECT = "SELECT '"
sSQL_FROM = "FROM tbl"
sSQL_UNION_ALL = "UNION ALL"
arSQL_Elements(1) = sSQL_SELECT & arDataSheetNames(1) & "' AS [source], *"
arSQL_Elements(2) = sSQL_FROM & "1"
For j = 2 To UBound(arDataSheetNames)
arSQL_Elements(3 * j - 3) = sSQL_UNION_ALL
arSQL_Elements(3 * j - 2) = sSQL_SELECT & arDataSheetNames(j) & "' AS [source], *"
arSQL_Elements(3 * j - 1) = sSQL_FROM & j
Next j
'Hence the SQL to combine the data from multiple sheets
sSQL = Join$(arSQL_Elements, vbCr)
' Debug.Print sSQL
Set wbkNew = Application.Workbooks.Add(xlWBATWorksheet)
With wbkNew.Worksheets(1)
.Name = "combined data"
With .QueryTables.Add(Connection:=sConn, Destination:=.Range("A1"), Sql:=sSQL)
.Refresh BackgroundQuery:=False
End With
.Cells.NumberFormat = "#,##0"
End With
Set wbkNew = Nothing
Application.ScreenUpdating = True
MsgBox "Here is the new file!!"
End Sub
