タブの名前を自動的に変更

Question

以下のスクリプトはループしてタブを作成し、タブに名前をつけて、タブ名をセルB3に配置します。それは正常に動作していますが、今はすべてのランタイムエラー1004をキャッチします。私のスクリプトの最後に、タブの名前を変更します。これがエラーの発生場所です。タブを作成していますが、名前を変更できません。誰でもこのスクリプトのタブの名前を変更する別の方法を提案してください。 Sheets（Name）.Selectにエラーがあります。

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

私はすべての選択の中で迷ってしまったので、元のコードが失敗した理由がわかりません。私はあなたの質問を編集して読みやすくしましたが、私の編集が見直されるまで改善が見えるだけです。

すべての選択ステートメントを削除しました。私が他の変更を加えた理由を説明するコメント '##。

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 

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

堅牢なコードを書くことは非常に重要です。どんなシナリオでも失敗してはいけません。例えば、適切なエラー処理が行われ、変数が宣言されていなければなりません。

私はこれを読むことをお勧めします。

トピック：今すぐ戻ってあなたのコードにhttp://www.siddharthrout.com/2011/08/01/to-err-is-human/

「のErr」には

リンク人間です。私はコードを修正しました。これを試して。私もコードをコメントしているので、それを理解するのに何の問題もないはずです。まだあなたがしたら、ただ叫び声を出してください。

コード

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