Extract data from multiple sheet into one with conditions

TheCarb1 

Please find the attached with a code called GetTimeTableSummary on Module1. There is also a Class Module named clsTimeTable with some public variables.

If you have to implement the codes to your original workbook, you will be required to copy both the Module1 and clsTimeTable codes to your workbook.

The codes assume that in your file, the name of all the Class Sheets starts from CLASS and will create a Summary Tab with all the data from the CLASS Sheets sorted by Date and Start Time.

You will also find a button called Create Summary on CLASS 1 Sheet, you may click this button to run the code.

You may also run the code by pressing a shortcut key Ctrl+Shift+R to create the Summary.

Sub GetTimeTableSummary()
Dim ws          As Worksheet
Dim wsSummary   As Worksheet
Dim tb          As clsTimeTable
Dim x           As Variant
Dim Coll        As New Collection
Dim i           As Long
Dim j           As Long
Dim r           As Long
Dim strTime     As String

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "CLASS*" Then
        x = ws.Range("A1").CurrentRegion.Value
        For i = 2 To UBound(x, 1)
            For j = 4 To UBound(x, 2)
                If x(i, j) <> "" Then
                    strTime = x(1, j)
                    Set tb = New clsTimeTable
                    tb.Period_Date = x(i, 1)
                    tb.Period_Day = x(i, 2)
                    tb.period_Hours = x(i, 3)
                    tb.StartTime = Replace(Split(strTime, "-")(0), ".", ":")
                    tb.EndTime = Replace(Split(strTime, "-")(1), ".", ":")
                    tb.Subject = x(i, j)
                    tb.ClassName = ws.Name
                    Coll.Add tb
                End If
            Next j
        Next i
    End If
Next ws

On Error Resume Next
Set wsSummary = Worksheets("Summary")
wsSummary.Cells.Clear
On Error GoTo 0

If wsSummary Is Nothing Then
    Set wsSummary = Worksheets.Add(before:=Worksheets(1))
    wsSummary.Name = "Summary"
End If

wsSummary.Range("A1:G1").Value = Array("Date", "Day", "Start Time", "End Time", "Hours", "Subject", "Class")

r = 2

For i = 1 To Coll.Count
    Set tb = Coll(i)
    wsSummary.Cells(r, 1) = tb.Period_Date
    wsSummary.Cells(r, 2) = tb.Period_Day
    wsSummary.Cells(r, 3) = tb.StartTime
    wsSummary.Cells(r, 4) = tb.EndTime
    wsSummary.Cells(r, 5) = tb.period_Hours
    wsSummary.Cells(r, 6) = tb.Subject
    wsSummary.Cells(r, 7) = tb.ClassName
    r = r + 1
Next i
With wsSummary
    .Range("A1").CurrentRegion.Sort key1:=wsSummary.Range("A2"), order1:=xlAscending, key2:=wsSummary.Range("C2"), order2:=xlAscending, Header:=xlYes
    
    With .Range("A1").CurrentRegion
        .Offset(1).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=AND($A2<>"""",MOD(SUM(--(FREQUENCY($A$2:$A2,$A$2:$A2)>0)),2)=1)"
        .Offset(1).FormatConditions(1).Interior.Color = RGB(242, 242, 242)
        
        .Offset(1).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=AND($A2<>"""",MOD(SUM(--(FREQUENCY($A$2:$A2,$A$2:$A2)>0)),2)=0)"
        .Offset(1).FormatConditions(2).Interior.Color = RGB(221, 235, 247)
        
        .Borders.Color = vbBlack
        .AutoFilter
    End With
    .Rows(1).Font.Bold = True
    .UsedRange.Columns.AutoFit
    .Select
End With

Application.ScreenUpdating = True
End Sub

Let me know if this is what you were trying to achieve.