Last Loop Iterations不会重命名目标工作表

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进行更改。 1}}和WEB。

另外，请注意，我在评论EDV和xNSht.RowHeight = 409时引发了编译错误 （这是另一个问题）;并且我还尝试过放置冗余的重命名if语句，但是它也没有重命名工作表。