エクセルでシートを追加するマクロについて

質問

マクロ初心者ですよろしくお願いします
エクセルでシート１は名前などの入力用、シート２はフォーム用として作成しております
シート１のＡ１から最大でＡ２０（変動あり）に名前を入力すると名前の数だけシート２のコピーが追加され、シート名も入力した名前に変更する場合のマクロはどうすれば良いのでしょうか？
またシート２のＢ１にも入力した名前を表示させたいです
ご教授お願いいたします

回答No.1

tom04 · ベストアンサー

こんばんは！

＞またシート２のＢ１にも入力した名前を表示させたいです
の部分が違っているかもしれませんが・・・
（追加したSheetのB1セルに追加Sheet名を表示しています）

Alt＋F11キー　→　画面左側の「This Workbook」をダブルクリック　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sheet追加() 'この行から
Dim i As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1") '←「Sheet1」は実際のSheet名に！
Set ws2 = Worksheets("Sheet2") '←こちらのSheet名も！
For i = 1 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
Worksheets.Add after:=Worksheets(Worksheets.Count)
ws2.Cells.Copy Destination:=Worksheets(Worksheets.Count).Range("A1")
With Worksheets(Worksheets.Count)
.Name = ws1.Cells(i, 1)
.Range("B1") = ws1.Cells(i, 1)
End With
Next i
End Sub 'この行まで

こんな感じではどうでしょうか？m（_ _）m

お礼

私の思ったとおりの結果がでました
大変ありがとうございました

回答No.2

cj_mover

こんにちは
お邪魔します

／／／
シート１のシートタブを右クリックして
表示されたポップアップメニューの[コードの表示]をクリック
表示されたウィンドウの中央部にあるウィンドウ（シートモジュールのCodePane）
に、以下をコピー＆ペーストします。
' ' ===============ここから===============
Private Sub Worksheet_Change(ByVal Target As Range) ' okg7589017
　　Const STTL = "シート名を指定しながら追加コピー"
　　Dim shMst As Worksheet
　　Dim r As Range
　　Dim sNm As String, bufE As String
　　Dim nShCnt As Long

　　If Target.Column > 1 Then Exit Sub

　　nShCnt = Sheets.Count
　　Set shMst = Sheets("シート２") ' ●コピー元のシート名を指定●

　　Application.ScreenUpdating = False
　　For Each r In Target.Columns(1).Cells
　　　　sNm = r.Text
　　　　If sNm <> "" Then
　　　　　　shMst.Range("B1").Value = r.Value
　　　　　　shMst.Copy After:=Sheets(nShCnt)
　　　　　　nShCnt = nShCnt + 1
　　　　　　On Error GoTo ErrN_
　　　　　　Sheets(nShCnt).Name = r.Value
　　　　　　On Error GoTo 0
　　　　End If
　　Next r
　　Application.ScreenUpdating = True

　　Set shMst = Nothing
　　If bufE = "" Then
　　　　MsgBox "正常", vbInformation, STTL
　　Else
　　　　MsgBox bufE, vbExclamation, STTL
　　End If
　　Exit Sub
ErrN_:
　　If bufE = "" Then bufE = _
　　　　"シート名に指定した文字列が不適切な為、以下のシートは作成できませんでした"
　　bufE = bufE & String(2, vbLf) & vbTab & "◆無効な名前◆" & vbTab & sNm _
　　　　& String(2, vbLf) & "Err.Number◆" & Err.Number _
　　　　& vbLf & "Err.Description◆" & Err.Description
　　Application.DisplayAlerts = False
　　Sheets(nShCnt).Delete
　　Application.DisplayAlerts = True
　　nShCnt = nShCnt - 1
　　Resume Next
End Sub
' ' ===============ここまで===============
●コピー元のシート名が "シート２" でない場合は必ず指定●し直してください。
キーボードの Alt + F11 を同時に押してシート１に戻ります。
これで、シート１のＡ列に変更があった時に処理するようになります。
お求めの処理と違いがないか、試してみてください。

／／／

とりあえず、なるべく無難なものを、という意図で書いたものを提示しました。
もっと簡単にも書けるし、もっと堅実なやり方もあるでしょう。

(1)　シート１のＡ列で変更があったセルの値を取得する
(2)　その値をシート２のＢ１に設定する
(3)　シート２のコピーを作る。
(4)　コピーされたシートの名前を先に取得したシート１のＡ列の変更値にする。

ＶＢＡを覚えるのなら、以上の４点だけ出来る様になれば、自力でも解決可能です。
何れも初級としても取っつき易い基本課題です。
特に(3)(4)は記録マクロでコードの骨格を得ることも可能です。
ちょっとずつでも、一部分だけでも、自作を目指しつつＶＢＡへの理解を深めていってください。
自分で作ったものを、自分で使って、自分で改良して、というのが理想ではあります。
自分で試しに書いてみて、解らない事、上手くいかないこと、
等を、また質問してくれたら、、、と思います。

／／／

私のですが、何故、あんなに長ったらしいのか、訳を書いておきます。
これはＶＢＡではなくて、ＥＸＣＥＬの一般機能からの要求として、
シート名には色々と制限がある、というのが理由です。

［１］シート名に空文字を指定することは出来ません
［２］シート名に同一ブックのシート名等に既に使われている名前を指定することは出来ません
［３］シート名に３１文字を超える文字列を指定することは出来ません
［４］シート名に使えない文字が複数あります　例：　" : \ ? [ ] / * '
［５］シート名としてそのまま指定することができない単語（予約語）が複数あります　例：　履歴

手作業で試してみるとわかると思いますが、「名前が正しくありません」とか、ＥＸＣＥＬが叱ってくれます。
ＶＢＡでも放っておけば叱られますが、それだけでなく、エラーが出て結構面倒な事になります。
なので、私が書いたものでは、シート名の指定が不適切であった場合、エラーが起きても中断せずに、
その分のシート作成は止めて、不適切なシート名を告知するメッセージを表示するようにしています。

ま、シート１のＡ列が適正な値であるなら、無くても良さそうな処理を加えている、とも言えますが、

もうひとつ、
１セルずつ手入力する場合だけでなくて、
複数セルを纏めてコピー貼り付けした場合にも、エラー無く対応できるようにしてます。
シート名入力済で未処理のものなどあれば、一旦シート１のＡ列にある範囲をコピーして
そのまま貼り付ければ処理されます。
要は、なるべく無難に、、、という、、、。

で、私が書いたのは、質問者さんが自作するものが動くようになるまでのつなぎってことで、
これをすぐに理解して欲しいとかおもってないですから、お気楽に。

以上です。
／／／

Re:#1 ws1、何故、Variant型を使うのですか ？ 何故、ThisWorkbookモジュールなのですか ？

お礼

大変ありがとうございました
色々なルールがあって大変勉強になりました
これからの参考にさせて頂きます