Excel is such a wonderful and versatile tool. It is so easy to use.
It is also very easy to make dreadful mistakes that make a workbook extremely difficult to use.
One of those mistakes is putting similar data on multiple sheets. I see sheets for Jan, Feb, Mar, or Salesman A, Salseman B, or Area 1, Area 2 etc. You're really shooting yourself in the foot by chopping data up like this.
Excel features are designed to work on a single table of data. If you had ALL your data in a table, you could very simply, in almost every case, report your daily, weekly, monthly quarterly, yearly, Salesmen, Areas, WHATEVER, in SECONDS, using one of Excel data analysis or data reporting tools.
So here's a program to enable you to get all the similar data into ONE TABLE.
First, copy the
similar SHEETS into a new workbook. This program will only work if the workbook has
similar SHEETS.
By
similar SHEETS I mean that ALL sheets have
[tt]
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
[/tt]
For instance, column A on every sheet has DATES, column B on every sheet has NAMES, column C on every sheet has AMOUNTS.
If ROW 1 does not have headings, insert and empty row and ENTER heading values in each data column. You can COPY this row to each sheet if necessary.
Copy the program into a MODULE in the new workbook. When you RUN the program, it will create a Summary sheet and combine all the data into that sheet. Then you can COPY the sheet or the data on the sheet to your original workbook.
Code:
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
