Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
Sub CombineAllSheets()
'SkipVought @ Tek-Tips 2010 feb 26
'assuming that ALL sheets have
' 1) the same number of columns of data
' 2) one row of headings in row 1
' 3) each corresponding column of data has the same TYPE of data on each sheet
' then the query will consolidate the data into the Summary sheet
Dim ws As Worksheet, sSQL As String, iCnt As Integer, sConn As String
On Error Resume Next
If IsError(Sheets("Summary")) Then Worksheets.Add.Name = "Summary"
On Error GoTo 0
sConn = "ODBC;DSN=Excel Files;"
sConn = sConn & "DBQ=" & ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & ".xls;"
sConn = sConn & "DefaultDir=" & ThisWorkbook.Path & ";"
sConn = sConn & "DriverId=790;MaxBufferSize=2048;PageTimeout=5;"
For Each ws In Worksheets
If ws.Name <> "Summary" Then
iCnt = iCnt + 1
sSQL = sSQL & "Select *, '" & ws.Name & "' as Sheet"
sSQL = sSQL & vbLf
sSQL = sSQL & "From [" & ws.Name & "$]"
sSQL = sSQL & vbLf
If iCnt < Worksheets.Count - 1 Then
sSQL = sSQL & "UNION ALL"
sSQL = sSQL & vbLf
End If
End If
Next
Debug.Print sSQL
With Sheets("Summary")
If .QueryTables.Count = 0 Then
With Sheets("Summary").QueryTables.Add(Connection:=sConn, _
Destination:=Sheets("Summary").Range("A1"))
.CommandText = sSQL
.Name = "qryALL"
.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
Else
With Sheets("Summary").QueryTables("qryALL")
.Connection = sConn
.CommandText = sSQL
.Refresh BackgroundQuery:=False
End With
End If
End With
End Sub