自动重命名选项卡

下面的脚本循环创建选项卡并命名选项卡，然后将选项卡名称放在单元格B3中。它一直运行良好，但现在给出了catch-all运行时错误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

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

我建议你读这篇文章。

主题："错误"是人类

链接：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

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

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

我已经删除了您选择的所有语句。以"##"开头的注释解释了我进行其他更改的原因。

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

相关内容

最新更新

热门标签：