Прокрутите VBA по рабочим листам, чтобы проверить наличие проблем

Вам не нужно вносить какие-либо изменения во второй подпункт «Checkoverlap».

Изменения в первом сабвуфере

• With Sheets(ws).Activate - Activate — это метод. Его нельзя использовать в предложении With.
• Вставьте .перед Range() и Columns() внутри With...End With, чтобы уточнить объект диапазона.

Документация Майкрософт:

С заявлением

Option Explicit

Sub Demo()
    Call SwitchOff
    Dim ws As Long
    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
    Const HEADER_START = "G1"
    Dim objDic As Object, c As Range
    Set objDic = CreateObject("scripting.dictionary")
    For ws = 10 To 16
        With Sheets(ws)
            objDic.RemoveAll
            ' 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
            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