【Excel VBA】範囲を可変で名前の定義を設定する

データの入力規則を設定するときに、リストを作って範囲を設定するのが毎回面倒くさいので、マクロ化。
アクティブセルのある行の先頭を定義名として、2行目以降を参照範囲に使います。

Option Explicit

'---------------------------------------------------------------------------------------------------
'定数
'---------------------------------------------------------------------------------------------------
'可変名前定義の数式
Private Const defineNameFormulaTemplate As String = "=OFFSET('{シート名}'!${列Index}2,0,0,COUNTA('{シート名}'!${列Index}:${列Index})-1,1)"

'---------------------------------------------------------------------------------------------------
'【処 理 名】可変名前定義作成
'【引    数】なし
'【返 却 値】なし
'【処理概要】アクティブセルの列に、名前の定義を設定する。1行目を定義する名前に使用し、2行目から
'          リストが始まることを前提とする。
'---------------------------------------------------------------------------------------------------
Public Sub 可変名前定義作成()
    Dim definName As String            '定義する名前
    Dim sheetName As String            'リストがあるワークシート名
    Dim columnIndex As String          '列インデックス
    Dim defineNameFormula As String    '可変名前定義の数式
        
    '----------------------------------------------------------------
    '数式の生成
    '----------------------------------------------------------------
    'リストがあるワークシート名
    sheetName = ActiveWorkbook.ActiveSheet.Name
    '列のインデックスを取得する
    columnIndex = Split(ActiveCell.Address, "$")(1)
    
    '数式を生成する
    defineNameFormula = Replace(defineNameFormulaTemplate, "{シート名}", sheetName)
    defineNameFormula = Replace(defineNameFormula, "{列Index}", columnIndex)
    
    '----------------------------------------------------------------
    '名前を定義する
    '----------------------------------------------------------------
    '定義する名前は、アクティブセルの行の1行目から取得する
    definName = Cells(1, ActiveCell.Column).Value
    '名前の定義を設定する
    ActiveWorkbook.Names.Add Name:=definName, RefersTo:=defineNameFormula
End Sub