Question

下面的脚本循环创建选项卡并命名选项卡然后它将选项卡名称放在单元格B3中。它一直工作正常但现在给出了捕获所有运行时错误1004.在我的脚本底部它重命名选项卡。这是错误发生的地方。它正在创建选项卡但无法重命名。任何人都可以建议另一种方法来重命名此脚本中的选项卡。错误发生在表格（名称）上。选择。

Public Sub CreateTabs()
  Sheets("TABlist").Select
  ' Determine how many Names are on Data sheet
  FinalRow = Range("A65000").End(xlUp).Row
  ' Loop through each Name on the data sheet
  For x = 1 To FinalRow
    LastSheet = Sheets.Count
    Sheets("TABlist").Select
    Name = Range("A" & x).Value
    ' Make a copy of FocusAreas and move to end
    Sheets("TABshell").Copy After:=Sheets(LastSheet)
    ' rename the sheet and put name in Cell B2
    Sheets(LastSheet + 1).Name = Name
    Sheets(Name).Select
    Range("B3").Value = Name
  Next x 
End Sub

Answer 1

编写健壮的代码非常重要。在任何情况下都不应该失败。例如，应该进行适当的错误处理并声明变量。

我建议阅读此内容。

主题：'Err'是人类

链接：http://www.siddharthrout.com/2011/08/01/to-err-is-human/

现在回到你的代码。我修改了代码。试试这个。我也对代码进行了评论，所以你不应该有任何理解它:)如果你这样做，那就大声说出来。

<强>代码

Option Explicit

Public Sub CreateTabs()
    Dim ws As Worksheet
    Dim FinalRow As Long, x As Long, LastSheet As Long
    Dim name As String

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    Set ws = Sheets("TABlist")

    FinalRow = ws.Range("A" & Rows.Count).End(xlUp).Row

    For x = 1 To FinalRow
        LastSheet = Sheets.Count

        '~~> Get the name for the new sheet
        name = ws.Range("A" & x).Value

        '~~> Check if you already have a sheet with that name or not
        If Not SheetExists(name) Then
            Sheets("TABshell").Copy After:=Sheets(LastSheet)
            ActiveSheet.name = name
            Range("B3").Value = name
        End If
    Next x

LetsContinue:
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function to check if sheet exists
Function SheetExists(wst As String) As Boolean
    Dim oSheet As Worksheet
    On Error Resume Next
    Set oSheet = Sheets(wst)
    On Error GoTo 0

    If Not oSheet Is Nothing Then SheetExists = True
End Function

Answer 2

Excel工作簿中的每个工作表名称都必须是唯一的。

作为查看导致错误的名称的快速修复，请尝试使用此代码，然后根据列表检查工作表名称。

Public Sub CreateTabs()

On Error Resume Next

  Sheets("TABlist").Select
  ' Determine how many Names are on Data sheet
  FinalRow = Range("A65000").End(xlUp).Row
  ' Loop through each Name on the data sheet
  For x = 1 To FinalRow
    LastSheet = Sheets.Count
    Sheets("TABlist").Select
    Name = Range("A" & x).Value
    ' Make a copy of FocusAreas and move to end
    Sheets("TABshell").Copy After:=Sheets(LastSheet)
    ' rename the sheet and put name in Cell B2
    Sheets(LastSheet + 1).Name = Name
    Sheets(Name).Select
    Range("B3").Value = Name
  Next x

On Error GoTo 0

End Sub

Answer 3

我在所有选择中迷失了所以我不确定为什么你的原始代码失败了。我编辑了你的问题，使其更具可读性，但只有在我编辑同行评审之前，我才能看到改进。

我删除了所有的select语句。评论开头'##解释为什么我做了其他更改。

Option Explicit
Public Sub CreateTabs()

   Dim CrntRow As Long              '## I like names I understand
   Dim FinalRow As Long
   Dim Name As String

   ' Determine how many Names are on Data sheet
   '## Row.Count will work for any version of Excel
   FinalRow = Sheets("TABlist").Cells(Rows.Count, "A").End(xlUp).Row
   ' Loop through each Name on the data sheet
   For CrntRow = 1 To FinalRow
     Name = Sheets("TABlist").Range("A" & CrntRow).Value
     ' Make a copy of FocusAreas and move to end
     Sheets("TABshell").Copy After:=Sheets(Worksheets.Count)
     ' rename the sheet and put name in Cell B2
     '## The copy will be the active sheet
     With ActiveSheet
       .Name = Name
       .Range("B3").Value = Name
     End With
   Next CrntRow

End Sub

自动重命名标签

3 个答案: