Sub 以指定区域为表目录补充新表()
    Dim dic As Object, SH As Worksheet
    Dim arr, item
    arr = Range("B1:BB1")
    Set dic = CreateObject("scripting.dictionary")
    For Each SH In ThisWorkbook.Worksheets
        dic.Add SH.Name, ""
    Next
    For Each item In arr
        If item <> "" And Not dic.exists(Trim(item)) Then
            With ThisWorkbook.Worksheets.Add
                .Name = item
            End With
        End If
    Next
    Set dic = Nothing
End Sub

Sub 以指定区域为表目录补充新表()
    Dim dic As Object, SH As Worksheet
    Dim arr, item
    arr = Range("B1:BB1")
    Set dic = CreateObject("scripting.dictionary")
    For Each SH In ThisWorkbook.Worksheets
        dic.Add SH.Name, ""
    Next
    For Each item In arr
        If item <> "" And Not dic.exists(Trim(item)) Then
            With ThisWorkbook.Worksheets.Add
                .Name = item
            End With
        End If
    Next
    Set dic = Nothing
End Sub