シート作成のマクロについて どなたかご教授ください。 テンプレートとリストがあります。 sheet(

シート作成のマクロについて

どなたかご教授ください。
テンプレートとリストがあります。
sheet(リスト)のデータ項目をsheet(テンプレート)をコピーし、シート作成するということが目的でした。←ここまでは、下記のマクロで出来ました。

私が作ったマクロだと項目が増えて、また同じマクロを実行するとエラー(同じシート名があるため)となってしまいます。
そこで、やりたい事は、元あるデータはそのままで、追加した分だけ、テンプレートをコピーしてシートを作成したいです。色々調べても、元あるデータは削除が多いため、調べても答えが見つかりませんでした。
どなたか教えて頂ければ、幸いです。よろしくお願いします。


Sub シート作成()

Dim ナム As Range
Dim z As Integer

z = Worksheets("リスト").Cells(Rows.Count, "A").End(xlUp).Row
For i = 4 To z

For Each ナム In Worksheets("リスト").Cells(i, "A")

Worksheets("テンプレート").Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = ナム.Value
ActiveSheet.Range("A1") = ナム.Value

Next

Next i



End Sub


※以下、追記
sheet リスト↓

項目
1
2
2.5←新たに追加
3
4
5

新しく項目が加わっても、sheetが項目順になれば、良いなと思っております。

No.3 ベストアンサー 回答者： Qchan1962 回答日時： 2021/10/13 12:26

こんにちは

すでにシート名リストがA列にあると言う事でしょうか
リストの途中に新しい名前を追加してシートを作成する場合で
一例サンプルを示します。私の持ち合わせ改造ですのでよくある方法かと、、（間違った解釈かも知れません）
関数式の処理の場合、式は示される事が多いのですが、VBA処理の場合、コードが示される事が少ないです
VBA実行のリスクを理解した上で自己責任で検証してください。

’シートリストが作成されている事が条件になります。
Sub シート作成()
Dim ナム As Range
Dim z As Range
Dim chk As String
With Worksheets("リスト")
Set z = .Range("A4", .Cells(Rows.Count, "A").End(xlUp))
End With
chk = word_chk(z)
If chk <> "" Then
MsgBox (chk)
Else
For Each ナム In z
If Not same_name_chk(ナム.Text) Then
Worksheets("テンプレート").Copy After:=Worksheets(ナム.Offset(-1).Text)
ActiveSheet.Name = ナム.Value
ActiveSheet.Range("A1") = ナム.Value
End If
Next
End If
End Sub
'同名チェック
Function same_name_chk(chkName As String)
Dim ws As Worksheet, flag As Boolean
For Each ws In Worksheets
If ws.Name = chkName Then flag = True
Next ws
same_name_chk = flag
End Function
'NG文字
Function word_chk(Rng As Range)
Dim r As Range, k As Variant
If WorksheetFunction.CountBlank(Rng) > 0 Then
word_chk = "範囲内に空白があります": Exit Function
End If
For Each r In Rng
For Each k In Array(":", "\", "/", "?", "*", "[", "]")
If InStr(r.Value, k) > 0 Then
word_chk = r.Address(0, 0) & "に使用出来ない文字があります": Exit Function
End If
Next k
If Len(r.Text) > 31 Then
word_chk = r.Address(0, 0) & "は文字が多すぎます": Exit Function
End If
Next r
word_chk = ""
End Function

私は独学で覚える時、出来ているものを検証、分解して覚えました
基礎から積み上げるのが正しいと思いますが、プログラマーになるつもりがないのなら、どちらでもいいのかな、、と思います。学習方法は、お任せしますので鵜呑みにせず理解して試してください。これを怠けると自身で作成する事は出来ないので。。

この回答へのお礼

ご丁寧にありがとうございました。成功しました。まだまだ勉強不足なので、これから頑張ります！アドバイスもありがとうございました！

お礼日時：2021/10/14 18:33

No.2 回答者： fujillin 回答日時： 2021/10/13 08:52

こんにちは

＞また同じマクロを実行するとエラー(同じシート名があるため)となってしまいます。
シートを作成する前に、既に同名のシートが存在するかどうかをチェックして、存在したら何もせずに次へ進むようにすれば宜しいでしょう。
◇シートの存在をチェックする方法の例
・既存のシート名をチェックする方法
https://www.tipsfound.com/vba/10009

・シートにアクセスし、エラー発生の有無で判断する方法
https://mk-55.hatenablog.com/entry/2017/05/24/00 …


＞sheetが項目順になれば、良いなと思っております。
全部のシートを作成し終わったところで、シートの並び替えを行えばよいと考えられます。
◇シートの並び替え処理の例
・既に並べ替え後のリストができている状態なので、後半のみを参考にすれば宜しいかと。
https://vbabeginner.net/sort-sheets-any-order/


なお、ご質問には直接関係ありませんけれど・・・
ご提示のコードでは
　For Each ナム In Worksheets("リスト").Cells(i, "A")
　　'～～～ 処理 ～～～
　Next
として、ループさせる構文になっていますけれど、必よな処理は一回だけなのでループ構文にする必要がありません。
そのままでも、一回しかループしないので問題にはなりませんけれど、コードを無用に複雑にしているだけと言えます。

この回答へのお礼

ご丁寧にありがとうございました。

お礼日時：2021/10/14 18:35

No.1 回答者： ずんだしらたま 回答日時： 2021/10/13 07:32

ナム.Value を　ナム.Text に変えてみて下さい。

数値として代入しているので、小数点以下が切り捨てられているかも知れません。

この回答へのお礼

無事に解決しました。ありがとうございました。

お礼日時：2021/10/14 18:35