Последняя итерация цикла не переименовывает целевой лист

Question

Вот этот цикл, который я запускаю для извлечения отдельных Job Name, поместите его в новую таблицу с Job Name в качестве имени.Почти все итерации цикла работают, за исключением примерно последних двух итераций (содержащих ключевые слова WEB и EDV), которые работают при получении значений таблицы, но не переименовываетлист .

Вот код VBA, который я запускаю:

Option Explicit
Sub Create_New_Sheets()

    Dim xRCount As Long
    Dim xSht As Worksheet
    Dim xNSht As Worksheet
    Dim I As Long
    Dim xTRrow As Integer
    Dim xCol As New Collection
    Dim xSUpdate As Boolean
    Set xSht = ActiveSheet
    On Error Resume Next

    Dim strSearch As String
    Dim aCell As Range

    strSearch = "Job Title"

    Set aCell = xSht.Rows(1).Find(What:=strSearch, LookIn:=xlValues, _
    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    xRCount = xSht.Cells(xSht.Rows.Count, aCell.Column).End(xlUp).Row
    xTRrow = xSht.Range("Table1[#Headers]").Cells(1).Row
    For I = 2 To xRCount
        Call xCol.Add(xSht.Cells(I, aCell.Column).Text, xSht.Cells(I, aCell.Column).Text)
    Next
    xSUpdate = Application.ScreenUpdating
    Application.ScreenUpdating = False

    For I = 1 To xCol.Count
        Call xSht.Range("Table1[#Headers]").AutoFilter(aCell.Column, CStr(xCol.Item(I))) 'filter tool
        Set xNSht = Nothing
        Set xNSht = Worksheets(CStr(xCol.Item(I)))
        If xNSht Is Nothing Then
            Set xNSht = Worksheets.Add(, Sheets(Sheets.Count)) 'add new worksheet
            xNSht.Name = CStr(xCol.Item(I)) 'name new worksheet
        Else
            xNSht.Move , Sheets(Sheets.Count)
        End If
        xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1") 'get filtered copy
        'xNSht.RowHeight = 409
        'xNSht.ColumnWidth = 255
        'xNSht.Rows.AutoFit
        xNSht.Columns.AutoFit
        Call xNSht.Range("Table1[#Headers]").AutoFilter(aCell.Column, CStr(xCol.Item(I))) 'filter tool
        Cells.Find(What:=strSearch, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Value Like "WEB*" And ActiveCell.Value Like "*EDV*" Then
            Debug.Print "TRUE"
            ActiveSheet.Name = ActiveCell.Value 'It also doesn't rename the Worksheet
        Else
            Debug.Print "FALSE"
        End If
    Next
    xSht.Activate
    ActiveSheet.ShowAllData
    Application.ScreenUpdating = xSUpdate

End Sub

При просмотре связанных переменных значения меняются соответственно , ноxNSht.Name не изменяется в соответствии с CStr(xCol.Item(I)), когда Job Title имеет и WEB, и EDV.

Также обратите внимание, что я прокомментировал xNSht.RowHeight = 409 и xNSht.ColumnWidth = 255 когда они выдают Ошибка компиляции (что является другим вопросом в другой раз) ;и я также попытался поставить избыточное переименование оператора if , но оно также не переименовывает рабочий лист.