『シートの複製』（くわっす）
お尋ねします。
Sheet1のA列に名前のリストが入力されており、
そのリストのデータと同じ名前の個別シートがあるのですが、
リストに新規データが追加された場合に、シートを複製してリストの新規データと同じ名前のシート名で作成することは可能でしょうか？
ーーー
【Sheet1】
Ａ列 Ｂ列 Ｃ列
地域名?@ ‥ ‥
地域名?A ‥ ‥
地域名?B ‥ ‥
地域名?C ‥ ‥
地域名?D ‥ ‥
：
ーーー
Dim Grpws As Worksheet
Dim GrpSheets As Variant
GrpSheets = Array("地域名?@", "地域名?A", "地域名?B", "地域名?C", "地域名?D")
For Each Grpws In Worksheets
If Not IsError(Application.Match(Grpws.Name, GrpSheets, 0)) Then
～～以下作業内容割愛～～
End If
ーーー
現状、リストの名前を直接Arrayでまとめているのですが、新規データが追加された場合に対応できないため、
１．シートの複製
２．シート名をリストの名前に変更
３．Arrayの中に含めて、作業を実行
できるようにしたいと考えています。
お力添えをいただければ幸いです。
不慣れなため、お伝えしている情報が不足しておりましたら申し訳ありません。
何かあれば追記しますので、どうぞよろしくお願いいたします。
＜ 使用 Excel：Microsoft365、使用 OS：Windows11 ＞
こんな感じでどうですか。（動作確認済み）
Sub test()
Dim ws1 As Worksheet
Dim ws As Worksheet
Dim wsName As Variant
Set ws1 = Worksheets("Sheet1")
For Each wsName In ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp)).Value
Set ws = Nothing 'こちらに書くほうが自然かも
On Error Resume Next
Set ws = Worksheets(wsName)
On Error GoTo 0
If ws Is Nothing Then
Worksheets("template").Copy Before:=Worksheets("template")
Set ws = ActiveSheet
ws.Name = wsName
End If
'このあと定例処理
ws.Range("B1").Value = ws.Name ' 架空例です
Next
End Sub
（xyz） 2026/02/12(木) 17:18:28
ワークシートの存在をチェックする方法は、少なくともあと二つあります。ほかの方にお願いします。 （xyz） 2026/02/12(木) 17:20:15
参考 https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheet.change https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheet.calculate(even)
>リストに新規データが追加された場合に、
というのはイベント駆動にしたいということではないでしょうか。 VBA全く知らないのでよくわからないのですが、 プロシージャ名(オブジェクト名？)を特定のものにするとイベント駆動するみたいです。 （ちくわ） 2026/02/12(木) 18:28:19
コードだけでなく、説明を追加しておきます。
(1) 最初に申し上げたいのは、 ・Sheet1のA列に対象となるシート名があるにもかかわらず、 ・VBAのコードのなかに別にArrayを（直接書き込んで）保持するというのは 設計として適切ではないという点です。
同じものをコードに書き込むのは、手作業になりますし、間違いも起きやいからです。 理論的にはマクロでマクロを操作できますが、そもそもそんなことする必要がありません。 Sheet1のA列のデータだけを、唯一のソースにして、それを直接読み込めばよいだけです。
(2)
次に、今のロジックは、
・各シートを順次見ていき、Sheet1にある対象シート名に該当すれば、なんらかの作業をするという方式。
そうではなくて、
・Sheet1にある対象シート名を順次見ていき、そのシートがあるかどうかを確認
・なければシートを追加
・その後、既定の作業を実施
とすればいい。
(3)シートの存在チェックについては、次の投稿に書きます。
(4) なお、Changeイベントプロシージャを使う案が出されていますが、 質問者さんからの回答を待ちたいと思います。 （そういう意図かもしれないし、そうでないかも知れません。こちらが答える話でもない）
# 私見を書きますと、この場合はイベントプロシージャに余り賛成できません。 # （Changeイベントプロシージャに関してはここで何十回と回答してますけど） # こうした多くのシートにわたる作業を、簡単な操作で起動してしまうイベントプロシージャで実行することは、 # かえって思わぬことに巻き込まれることがリスクとしてありえます。 # # イベントプロシージャで実行する内容が不明ですから、確定的なことは言えませんが。 # "単にセルを変更したいだけで、そういう処理（極端な場合累積計算など）計算をする積りでは無かった" # などといったことは起きがちです。 # マクロによる更新は、簡単に取り消しはできないので、修復が必要な場合は面倒なことになります。
# また、イベントプロシージャは見た目以上に気を使う論点がいろいろあります。 # （複数セルを同時に変更するケース（コピーペイスト等）への対応、消去動作への対応等々） # ステップを踏んで取り入れていくほうがよいと思います。 # 私は、提示されたマクロに機能追加する方向を推奨します。
>何かあれば追記しますので、どうぞよろしく とのこと。言行一致でお願したい。 回答者さんから確認のコメントがあるのですから。 （xyz） 2026/02/13(金) 15:58:58
シートの存在チェックをFunctionプロシージャにしてしまったほうが分かり易かったですね。
Sub test()
Dim ws1 As Worksheet
Dim ws As Worksheet
Dim wsName As Variant
Set ws1 = Worksheets("Sheet1")
For Each wsName In ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp)).Value
If isExist(CStr(wsName)) Then 'ワークシートの存在チェック
Set ws = Worksheets(wsName)
Else
Worksheets("template").Copy Before:=Worksheets("template")
Set ws = ActiveSheet
ws.Name = wsName
End If
'定例処理
ws.Range("B1").Value = 100 ' 架空の例です
Next
End Sub
Function isExist(s As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(s)
On Error GoTo 0
If ws Is Nothing Then
isExist = False
Else
isExist = True
End If
End Function
========================= ついでに別の手法にも触れておきます。 下記のように定義したうえで、isExistをisExist2またはisExist3に変更してみて下さい。
'ワークシートの存在チェック2（既存シートを逐一走査する方法）
Function isExist2(s As String) As Boolean
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name = s Then
isExist2 = True
Exit For
End If
Next
End Function
'ワークシートの存在チェック3（ワークシート関数ISREFを援用する方法）
Function isExist3(s As String) As Boolean
isExist3 = Evaluate("ISREF('" & s & "'!A1)")
End Function
（xyz） 2026/02/13(金) 16:01:08
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.