如何让VBA的CheckOverlap子程序循环遍历第10至16张工作表

我基于他人（感谢Taller）的VBA代码做了适配，实现了Demo子程序循环遍历第10至16张工作表，但CheckOverlap子程序仅能在第10张工作表生效，无法随循环在后续工作表执行。

以下是当前代码：

Sub Demo()
Call SwitchOff
Dim ws As Integer
For ws = 10 To 16

With Sheets(ws).Activate

    Dim i As Long, iCol As Long
    Dim arrData, rngData As Range, olRng As Range
    Dim arrRes, iR As Long, iM As Long, iH As Long
    Dim LastRow As Long, iOffSet As Long
    ' Init. output table
    Columns("F:F").ClearContents
    Columns("F:F").NumberFormatLocal = "hh:mm"
    Range("F2").Value = "6:00"
    Range("F3:F290").Formula = "=R[-1]C+TIMEVALUE(""0:5:0"")"
    ' load header location into Dict
    Const HEADER_START = "G1"
    Dim objDic As Object, c As Range
    Set objDic = CreateObject("scripting.dictionary")
    With Range(HEADER_START, Range(HEADER_START).End(xlToRight))
        .Offset(1).Resize(290).Clear
        For Each c In Range(HEADER_START, Range(HEADER_START).End(xlToRight)).Cells
            objDic(c.Value) = c.Column - Range(HEADER_START).Column
        Next
    End With
    ' load data into an array
    Set rngData = Range("A1").CurrentRegion
    arrData = rngData.Value
    ' loop through data
    For i = LBound(arrData) + 1 To UBound(arrData)
        iH = VBA.Hour(arrData(i, 1))
        iM = VBA.Minute(arrData(i, 1))
        ' round to x5/x0 min.
        If iM Mod 5 <> 0 Then
            iM = iM + (5 - iM Mod 5)
            If iM = 60 Then
                iH = iH + 1
                iM = 0
            End If
        End If
        ' before 6am in the next day
        If iH < 6 Then iH = iH + 24
        iOffSet = ((iH - 6) * 60 + iM) / 5
        If objDic.exists(arrData(i, 3)) Then
            iCol = objDic(arrData(i, 3))
            ' populate output table
            On Error Resume Next
            With Range(HEADER_START).Offset(1, iCol)
                CheckOverlap olRng, .Offset(iOffSet)
                .Offset(iOffSet).Value = arrData(i, 2)
                .Offset(iOffSet).Interior.Color = rgbLightGreen
                .Offset(iOffSet - 1).Interior.Color = rgbOrange
                .Offset(iOffSet - 2).Interior.Color = rgbOrange
                .Offset(iOffSet - 3).Interior.Color = rgbOrange
                .Offset(iOffSet - 4).Interior.Color = rgbOrange
                .Offset(iOffSet - 5).Interior.Color = rgbOrange
            End With
        Else
            MsgBox "Missing team in output header: " & arrData(i, 3)
        End If
    Next i
      If Not olRng Is Nothing Then
        olRng.Interior.Color = vbRed
    End If

End With
Next ws
End Sub

Sub CheckOverlap(ByRef allRng As Range, cRng As Range)
    Dim c As Range
    For Each c In cRng.Offset(-1).Resize(3)
        If Len(c.Value) > 0 Then
            If allRng Is Nothing Then
                Set allRng = Application.Union(c, cRng)
            Else
                Set allRng = Application.Union(allRng, c, cRng)
            End If
        End If
    Next
End Sub

内容的提问来源于stack exchange，提问作者Peter