Question : Compiling Data from Multiple Sheets to Single Sheet in Excel

I have a workbook that has schedule information in a consistent template format, grouped by week for each worksheet in my workbook. I am trying to compile all of the data into one worksheet. I have attached a sample file. I would like to be able to run a macro that compiles all the data from each sheet into 3 columns on a single sheet. The columns would be "Shift", "Date", and "Employee" with the fields from each cell in the matrix populating the consolidation sheet. Any help is appreciated.

Answer : Compiling Data from Multiple Sheets to Single Sheet in Excel

Just use this macro and it will do what you are looking for...Enclosed is the code and workbook for your reference where it will automatically create and in case if combine sheet is already there then delete it and will make it again and combine data from all worksheets to there...

Saurabh...

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:

           
           
             Sub combine()
    Dim ws As Worksheet, ws1 As Worksheet
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    On Error Resume Next
    Sheets("Combine").Delete
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Combine"
    Set ws1 = ActiveSheet
 
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Combine" Then
            If ws1.Application.WorksheetFunction.CountA(Rows(1)) = 0 Then
                ws.Rows(2).Copy ws1.Range("A1")
            Else
                ws.Rows(2).Copy ws1.Range("A" & ws1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row)
            End If
            Dim lcol As Long, lrow As Long, lrow1 As Long
            lcol = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
            lrow = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
            lrow1 = ws1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1
            ws.Range(Cells(3, 1).Address & ":" & Cells(lrow, lcol).Address).Copy ws1.Range("a" & lrow1)
        End If
    Next ws
 
    ws1.Select
    Cells.Select
    Selection.EntireColumn.AutoFit
    Range("a1").Select
 
 
    MsgBox ("Done")
 
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
 
End Sub
           
         

Open in New Window

Select All

Schedule-Test-File.xls (50 KB) (File Type Details)

data