シート名を入力規則に設定

コード

Sub 入力規則()

'すべてのシート名を取得し配列に格納
Dim shName() As String
ReDim shName(Sheets.Count - 1)     'シートの数で配列を再定義
Dim itm As Variant      'for each用のイテレータ（くり返し用変数）
Dim i As Integer        'イテレータ
For Each itm In Sheets
    shName(i) = itm.Name
    i = i + 1
Next itm

'すべてのシート名をカンマ区切りで結合
Dim strKisoku As String
strKisoku = Join(shName, ",")

'入力規則を設定
With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertInformation, Operator:= _
    xlBetween, Formula1:=strKisoku
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = "存在するシート名から選択"
    .ErrorMessage = "存在しないシート名です"
    .IMEMode = xlIMEModeNoControl
    .ShowInput = True
    .ShowError = True
End With

'AlertStyleメモ　情報：xlvalidalertinformation、警告：xlValidAlertWarning、クリティカル：xlValidAlertStop
End Sub

解説

参考サイト