Автоматическое копирование строк из таблицы на новый лист

Question

Я пытаюсь auto-copy определенный rows в Table от одного worksheet до отдельного worksheet.Ниже мой код.Первая половина скрывает / показывает конкретную Columns в зависимости от значения, введенного в Column B.Вторая половина предназначена для копирования через определенный rows, когда назначенное значение вводится в Column B.

Я могу заставить это работать, когда Мастер worksheet является Range, но не Table.Это моя попытка при форматировании Table.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B:B")) Is Nothing Then
    On Error GoTo safe_exit
    Application.EnableEvents = False
    '****************
    FilterAndCopy
    '****************
    Dim t As Range
    For Each t In Intersect(Target, Range("B:B"))
        Select Case (t.Value)
            Case "Change of Numbers"
                Columns("B:BP").EntireColumn.Hidden = False
                Columns("H:BL").EntireColumn.Hidden = True
                'do nothing
        End Select
    Next t

End If

safe_exit:
    Application.EnableEvents = True
End Sub

'****************

Sub FilterAndCopy()
    Dim rng As Range, sht1 As Worksheet, sht2 As Worksheet

    Set sht1 = Worksheets("MASTER")
    Set sht2 = Worksheets("CON")

    sht2.ListObjects(1).DataBodyRange.ClearContents

    With Intersect(sht1.Columns("B:BP"), sht1.ListObjects(1).DataBodyRange)
    .Cells.EntireColumn.Hidden = False ' unhide columns
    If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False

    Dim rngToCopy As Range
    .AutoFilter field:=1, Criteria1:="Change of Numbers"
    Set rngToCopy = Intersect(.SpecialCells(xlCellTypeVisible), sht1.Range("A:F, BL:BO"))
    Debug.Print rngToCopy.Address
    rngToCopy.Copy Destination:=sht2.Cells(4, "B")
    .Parent.AutoFilterMode = False

    .Range("H:BK").EntireColumn.Hidden = True ' hide columns
    End With
End Sub

Ошибка:

Subscript out of range