Test Data: 34,431 rows
Running time: Start to finish.... 4 minutes flat!
If I can work out the unique autofilter into an array I'll see if it's
any faster on one sheet using the visible only than creating the extra
sheets. But, for now the speed of it works perfectly. I greatly
appreciate all the help and suggestions in getting this to where it is
today. Thanks!

Sub Logic_All()
Copy_With_AdvancedFilter_To_Worksheets
Logic_Beta
Master
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Data" Or ws.Name = "LILO" Or ws.Name = "Control" Or
ws.Name = "MergeSheet" Then GoTo SkipSh
ws.Delete
SkipSh:
Next
Application.DisplayAlerts = True
End Sub

Sub Logic_Beta()
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Dim i As Long
Dim sh As Worksheet
For Each sh In Sheets
sh.Activate
If sh.Name = "Data" Or sh.Name = "LILO" Or sh.Name = "Control" Then
GoTo SkipSh
LastRowSh = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows,
SearchDirection:=xlPrevious).Row
Columns("K").ClearContents
Range("K1").Value = "Difference"
For i = 2 To LastRowSh
Start = Range("F" & i)
Finish = Range("G" & i)
Z = 0
For j = 2 To LastRowSh
StartCk = Range("F" & j)
FinishCk = Range("G" & j)
If StartCk Finish Or FinishCk < Start Then GoTo NextLine
If StartCk < Start And StartCk < Finish And FinishCk < Finish Then
Z = Z + ((FinishCk - Start) * 1440)
ElseIf StartCk Start And StartCk < Finish And FinishCk Finish Then
Z = Z + ((Finish - StartCk) * 1440)
ElseIf StartCk < Start And StartCk < Finish And FinishCk Finish Then
Z = Z + ((Finish - Start) * 1440)
ElseIf StartCk Start And StartCk < Finish And FinishCk < Finish Then
Z = Z + ((FinishCk - StartCk) * 1440)
ElseIf StartCk = Start And StartCk < Finish And FinishCk = Finish Then
Z = Z + ((Finish - Start) * 1440)
End If
NextLine:
Next j
Range("K" & i).Value = Z
Next i
SkipSh:
Next sh
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Sub Master()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Long
Dim shLast As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Delete the sheet "MergeSheet" if it exist
Application.DisplayAlerts = False
On Error Resume Next
ThisWorkbook.Worksheets("MergeSheet").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Add a worksheet with the name "MergeSheet"
Sheets(1).Activate
Set DestSh = ThisWorkbook.Worksheets.Add
DestSh.Name = "MergeSheet"
'loop through all worksheets and copy the data to the DestSh
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "Data" Or sh.Name = "LILO" Or sh.Name = "Control"
Then GoTo SkipSh
If sh.Name < DestSh.Name Then
Last = LastRow(DestSh)
shLast = LastRow(sh)
'This example copies everything, if you only want to copy
'values/formats look at the example below the first
example
sh.Range(sh.Rows(2), sh.Rows(shLast)).Copy
DestSh.Cells(Last + 1, "A")
End If
SkipSh:
Next
Application.Goto DestSh.Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub Copy_With_AdvancedFilter_To_Worksheets()
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Set ws1 = Sheets("Data") '<<< Change
'Tip : You can also use a Dynamic range name,
http://www.contextures.com/xlNames01.html#Dynamic
'or a fixed range like Range("A1:H1200")
Set rng = ws1.Range("B1").CurrentRegion '<<< Change
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
With ws1
rng.Columns(2).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("IV1"), Unique:=True
'This example filter on the first column in the range (change
this if needed)
'You see that the last two columns of the worksheet are used
to make a Unique list
'and add the CriteriaRange.(you can't use this macro if you
use the columns)
Lrow = .Cells(Rows.Count, "IV").End(xlUp).Row
.Range("IU1").Value = .Range("IV1").Value
For Each cell In .Range("IV2:IV" & Lrow)
.Range("IU2").Value = cell.Value
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & "
manually"
Err.Clear
End If
On Error GoTo 0
rng.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("IU1:IU2"), _
CopyToRange:=WSNew.Range("A1"), _
Unique:=False
WSNew.Columns.AutoFit
Next
.Columns("IU:IV").Clear
End With
With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub