シートをコピーして名前を付ける

筆箱にVBAのカンニングペーパーを入れる係のみすくです。こんにちは。

テンプレート用のシートをコピーして、
セルに書いておいた名前を付けていきます。
シートをどこにコピーするか自体は指定できますが、
末尾に追加以外はほとんどやることないので、問答無用で一番最後に追加します。

Option Explicit

Public Sub main()
    Dim sh As Worksheet      'ワークシートオブジェクト
    Dim arr As Variant       '作業領域配列
    Dim index As Long        'カウンタ
    Dim endRowIndex As Long  '最終行
    Dim tempSh As Worksheet  'テンプレートワークシート
    
    Set sh = ThisWorkbook.Worksheets("Sheet1")
    Set tempSh = ThisWorkbook.Worksheets("template")
    
    '末尾行
    endRowIndex = sh.Cells(Rows.Count, "A").End(xlUp).Row
    '配列に格納
    arr = sh.Range(sh.Cells(1, 1), sh.Cells(endRowIndex, 1))
    
    For index = 1 To UBound(arr)
        Call copyWorksheet(tempSh, arr(index, 1))
    Next index
    
    Set sh = Nothing
End Sub

'---------------------------------------------------------------------------------------------------
'【処 理 名】ワークシートのコピー
'【処理概要】テンプレートとなるワークシートをコピーし、末尾に追加。
'【引    数】[I]ByVal srcSh As Worksheet   コピー元ワークシートオブジェクト
'            [I]ByVal newShName As String  コピーしたシートにつける名前
'【返 却 値】なし
'---------------------------------------------------------------------------------------------------
Public Sub copyWorksheet(ByVal srcSh As Worksheet, ByVal newShName As String)
    srcSh.Copy After:=ThisWorkbook.Worksheets(Worksheets.Count)
    ThisWorkbook.Worksheets(Worksheets.Count).Name = newShName
End Sub

参考 Sheets.Copy メソッド (Excel)msdn