自动重命名标签

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