• ベストアンサー
  • 暇なときにでも

Excelのマクロでシートを追加する際のエラー対策

久しぶりにExcelのマクロについて 質問させていただきます。 Sub シート追加() Dim シート名 As String, シート確認 As Worksheet シート名 = InputBox("シート名を入力してください") For Each シート確認 In Worksheets If シート確認.Name = シート名 Then MsgBox "同じ名前のシートがあります", vbCritical Call シート追加 End If Next ActiveSheet.Copy before:=ActiveSheet ActiveSheet.Name = シート名 End Sub 作ったマクロをごくシンプルにして 記載させていただきました。 これにより、シート名を付けて 次々とシートを追加しているのです。 問題は、すでに同じ名前のシートがあった場合です。 うっかり同じ名前を入力しても 「同じ名前のシートがあります」と表示され 「OK」を押すと改めて 「シート名を入力してください」 と表示されるようにしました。 しかし、なぜかこの場合 新たに入力したシート名でシートが作られるだけでなく そのシート名に「(2)」が付いたシートまで作られ 実行時エラー '1004': シートの名前をほかのシート、Visual Basic で参照されるオブジェクト ライブラリまたは ワークシートと同じ名前に変更することはできません。 というエラーが表示されてしまうのです。 Excel2010でもExcel2003でも同じでした。 ステップインでたどってみたのですが 「同じ名前のシートがあります」 が表示された場合 まだ使っていない名前のシートを作っても 黄色いままで「End Sub」から「End If」へ移ってしまいます。 ちなみに 「同じ名前のシートがあります」にならなければ 「End If」で終了したことになり 黄色は消えます。 詳しい方にはごく簡単なことなのでしょうが いろいろ検索しても答えは得られませんでした。 ご回答をよろしくお願いいたします。

共感・応援の気持ちを伝えよう!

  • 回答数3
  • 閲覧数1294
  • ありがとう数13

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.3

こんにちは。 > If シート確認.Name = シート名 Then これは、まずいですね。TextCompare モードにしないと、いけません。 簡単なことではあっても、最初は、教わらないと分からない点がいくつかあります。 すぐに思いつくというものではありませんね。同名シートを探す方法は、On Error Resumne で、数式を入れてエラーが出れば、OKという方法もあります。 他にも、Like 演算子を使ってもよいのですが、そうすると、Option Compare Textにしなければなりませんが、ふつうは、StrComp関数を用います。一応、シート名チェックには、おまけも付けました。 '// Sub SheetAdd()  Dim ShName As Variant  Dim msg As String  Do   ShName = Application.InputBox("シート名を入力してください" & vbCr & msg, "シート名追加", Type:=2)   If VarType(ShName) = vbBoolean Or ShName = "" Then Exit Sub   msg = "'" & ShName & "'" & "そのシート名を適さないようです。"  Loop Until IsSheetName(ShName)  ActiveSheet.Copy Before:=ActiveSheet  ActiveSheet.Name = ShName End Sub Private Function IsSheetName(ShName As Variant) As Boolean 'シート名のエラーチェック   Dim v As Variant   Dim i As Integer   Dim sh As Object   '文字列の長さの制限   If Len(ShName) > 31 Then IsSheetName = False: Exit Function   '使用出来ない文字の検出   For Each v In Array(":", "\", "/", "?", "*", "(", ")")     i = InStr(1, ShName, v, vbBinaryCompare)     If i > 0 Then IsSheetName = False: Exit Function   Next v   For Each sh In ActiveWorkbook.Sheets     If StrComp(sh.Name, ShName, vbTextCompare) = 0 Then IsSheetName = False: Exit Function    Next sh   IsSheetName = True End Function '//

共感・感謝の気持ちを伝えよう!

質問者からのお礼

回答、ありがとうございました。 早速コピーして試させていただいたところ 希望していたとおりの操作ができました。 使用できない文字のチェックまで付けていただき 大変分かりやすかったです。 おっしゃるとおり マクロの世界には 詳しい人から教わらないと一歩も先へ進めないことが たくさんあるのですね。 また何かありましたら ぜひご指導いただければと思っております。 今後ともよろしくお願いいたします。

関連するQ&A

  • エクセルのマクロについて教えていただきたいのですが・・・

    見積書を作成しているんですが、1枚目のシート(見積書)に明細が書ききれなかった時に、マクロを実行すると、『明細書』と言う名前のシートが(1)~(5)枚目まで追加され、各シートの小計を1枚目のシートに書き出す・・・と言うマクロを作りたいのですが、うまくいかずに困っています>< 追加されるシートの元となる『見積もりマスター』と言うシートがあって、そのシート内でそれぞれのシートの小計は取れるのですが・・・ 下記のマクロの中に何か追加すればうまくいく方法はありますか?? (明細書は追加する時もあれば追加しない時もあってその都度、使う人が、最大5枚まで何枚追加するかを決めるそうです。) Sub Macro1() Dim cnt As Integer Dim wkNum As Double Dim ws As Worksheet  For Each ws In Worksheets   If Left(ws.Name, 4) = "明細書(" Then    If IsNumeric(Mid(ws.Name, 5, 1)) Then     wkNum = Val(Mid(ws.Name, 5, 1))     If cnt < wkNum Then      cnt = wkNum     End If    End If   End If  Next ws  If cnt >= 5 Then   MsgBox ("明細書シートが既に5枚以上あるため追加できません")   Exit Sub  Else   Sheets("明細マスター").Copy after:=Sheets(Worksheets.Count)   ActiveSheet.Name = "明細書(" & cnt + 1 & ")"  End If End Sub マクロ自体をあまり理解できてなくて、会社の人や、ここで教えていただいて進めているので、出来ればそのままコピーして使用できるようにしていただけるとありがたいです。 よろしくお願いします。

  • シート名でなくindex番号でシートの移動をしたい

    windows7 Excel2007でマクロ作成の初心者です。以下の点で困ってます。ご指導お願いします。 シートの次ページへ、およびページの前に戻るというコードをつくりましたが、文字列でなく、indexを使ってつくりたのでですが、思うようになりません。 現在のコードは Private Sub 次ページへ_Click() If ActiveSheet.Name <> "23.日本太郎" Then ActiveSheet.Next.Activate End If End Sub ---------------------------------- Private Sub 前に戻る_Click() On Error Resume Next If ActiveSheet.Name <> "1.日本花子" Then ActiveSheet.Previous.Activate End If End Sub これを Dim i As Integer For i = 1 To Worksheets.Count - 6 などを使って作りたいです、なぜかというとシートの増減で名前が変わったとき、いちいち名前を変更しなければならないからです。

  • マクロで値なしでシートをコピーしたい

    受注が追加されるたびに「納請書3」をペースに下記のマクロでシートを追加コピーします。 シートを追加すると G4 の発行日の値もそのままにコピーされ追加の都度消しています。 ご指導を仰ぎたいのは、 シートをコピーしたときは G4  の値は表示させたくないことが可能でしょうか。 可能ならご指導いただけませんでしょうか。 ※C10 に件名を入れたときにG4に発行日が表示されるマクロは下記です。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$10" Then Target.Offset(-6, 2).Value = Date End If End Sub ※シートの追加のマクロです。 Sub シートの追加() Dim NewNo As Integer NewNo = Sheets("月請求書").Index Sheets("納請書3").Copy Before:=Sheets("月請求書") ActiveSheet.Name = "納請書" & NewNo End Sub 宜しく御願いします。

その他の回答 (2)

  • 回答No.2

なかなか大胆な「再帰」の使い方で、小改造ではどうにも出来ませんでした。 動作を下記の様なコードで試してみました。 Dim level As Long Sub シート追加() Dim シート名 As String, シート確認 As Worksheet Debug.Print "level:", level シート名 = InputBox("シート名を入力してください") For Each シート確認 In Worksheets If シート確認.Name = シート名 Then MsgBox "同じ名前のシートがあります", vbCritical level = level + 1 Call シート追加 level = level - 1 End If Next ' ActiveSheet.Copy before:=ActiveSheet ' ActiveSheet.Name = シート名 'エラーになってしまうのでコメントアウト Debug.Print "ActiveSheet.Name = ", シート名 DoEvents: DoEvents: DoEvents End Sub ☆動作結果 既存のSheet1を3回Input後、新しいSheet4をInputしました。 level: 0 level: 1 level: 2 level: 3 ActiveSheet.Name = Sheet4 ActiveSheet.Name = Sheet1 ActiveSheet.Name = Sheet1 ActiveSheet.Name = Sheet1 既存の名前を入力する毎に、深いレベルに潜って行き、新しい名前を入力すると、順次戻ってきますが、コードの後半の部分が都度実行されます。 コメントアウトの部分を生かすと、最初にActiveSheetがコピーされてSheet4と改名され、その次にSheet4が一旦コピーされてSheet4(2)が生成した後、Sheet1に改名しようとして名前重複のエラーが発生して止まる事になります。 時間が無いので、突っ込みどころ満載とは思いますが、改善策の一例です。 キャンセル対策等、Office TANAKAのサイトがご参考になります。 Sub シート追加2() Dim シート名 As String, シート確認 As Worksheet Do シート名 = InputBox("シート名を入力してください") Loop Until sheetExistCheck(シート名) ActiveSheet.Copy before:=ActiveSheet ActiveSheet.Name = シート名 End Sub Function sheetExistCheck(newSheetName As String) As Boolean Dim シート確認 As Worksheet For Each シート確認 In Worksheets If シート確認.Name = newSheetName Then MsgBox "同じ名前のシートがあります", vbCritical sheetExistCheck = False Exit Function End If Next sheetExistCheck = True End Function なお、既存のSheet1に対して、小文字のsheet1をInputすると、同名チェックはくぐり抜けた後で、改名の時にエラーとなる事を発見しました。ご参考まで。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

詳しい回答をくださり ありがとうございました。 早速試してみたところ 無事に動作の確認が取れました。 最後に補足してくださっている 小文字のsheet1の件についても おっしゃるとおりの反応でした。 うっかりしないように気を付けます。 本当にありがとうございました。 また何かありましたら よろしくお願いいたします。

  • 回答No.1
  • bin-chan
  • ベストアンサー率33% (1403/4213)

> MsgBox "同じ名前のシートがあります", vbCritical > Call シート追加 の2行の間に Elseが足りない MsgBox "同じ名前のシートがあります", vbCritical ELSE Call シート追加 もっと言うと MsgBox "同じ名前のシートがあります", vbCritical Exit For Else Call シート追加

共感・感謝の気持ちを伝えよう!

質問者からのお礼

回答、ありがとうございます。 早速試してみたのですが どのような名前を入れても 「シート名を入力してください」が表示されるだけで 先へ進めなくなってしまいました。 何が原因なのでしょうか。

関連するQ&A

  • エクセルでマクロを使って新規シートを作成する方法を教えてください!(条件あります)

    初めて質問するのですが、エクセルで原紙シートのマクロまで全てをコピーして新規のシートを作成させるにはどうしたらいいですか? 新規のシートの特定のセルに入力した時に新規シートが作成されるようにできますか? 原紙は Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next If Target.Address = "$A$1" Then ActiveSheet.Name = Target.Value End If End Sub のマクロが現在できあがってます。これを残しつつできますか?よろしくお願いします!

  • マクロでハッパーリンク2

    先日、教えて頂いたマクロですが シートの名前を数字または英字(例AAA or 123)のみにすると、うまくいきますが ハイフンを途中で入れると(例ABG-352 or ABCD-03-005)うまくリンクがいきません どこをどこを直せばいいのでしょうか Sub 新しいシートの追加() Dim シート名 As String シート名 = InputBox("新しいシート名を入力してください", "シート名の指定") If シート名 <> "" Then Sheets("sheet2").Copy After:=Sheets("sheet2") ActiveSheet.Name = シート名 Sheets("sheet1").Select Range("B3").End(xlDown).Offset(1).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _ SubAddress:=シート名 & "!A1", TextToDisplay:=シート名 End If End Sub

  • [EXCEL] シートを統合するマクロ

    下記は全てのシートを"ALL"という名前のシートに統合するマクロのようですが、"ALL"というシートの一番上 一行が 空きになってしまいます。1行目から使用したいのですが、 どこをどう書き換えれば良いのでしょうか? Sub copy() s0 = ActiveSheet.Name Sheets.Add.Name = "ALL" s1 = ActiveSheet.Name For Each mySH In Sheets If mySH.Name <> s0 Then If mySH.Name <> s1 Then myE = Range("A65536").End(xlUp).Row + 1 myE2 = mySH.Range("A65536").End(xlUp).Row mySH.Range("1:" & myE2).copy Range(myE & ":" & myE) End If End If Next End Sub

  • EXCELのマクロのシートを指定する方法

    下記にあるEXCELのマクロは、以前こちらのサイトで教えて頂いたマクロです。 私の質問の仕方がまずかったのですが、シートが指定ではなくて、次のシートとなっています。 これを、1列の元データがシート2で新しく貼り付ける場所をシート1という風に変更したくていろいろやってみましたが、EXCELのマクロ自体、初心者で全然できませんでした…。 どなたか教えて頂けないでしょうか?よろしくお願いします。 下記のマクロは 【Excel2003でA列に1行にあるデータ(半角英数字)を次のシートに、1行ずつコピーして、それを5列に振り分けするというマクロです(ただし、コピーは2つずつの時もあります。) 元データ(これをシート2にしたい) ●A列 B列 C列  1  2  3  4  5  ・  ・ 加工後 (シート1に貼り付けたい) ●A列 B列 C列 D列 E列   1   1   2   2   3   3   4   4   5   5  『sub macro1()  dim i as long, j as long, k as long  dim n, m  on error resume next  k = application.inputbox("duplication", type:=1)  if k = 0 then exit sub  activesheet.next.range("A:E").clearcontents  for n = 1 to range("A65536").end(xlup).row   for m = 1 to k    activesheet.next.cells(j + 1, i + 1).value = cells(n, "A").value    i = (i + 1) mod 5    j = iif(i = 0, j + 1, j)   next m  next n  activesheet.next.select end sub』

  • エクセル マクロ エラー

    Sub 保存() Dim MySheetName As Variant MySheetName = InputBox("シート名を入力してください") If MySheetName = "" Then Exit Sub Sheets("1").Copy After:=Sheets(Worksheets.Count) ActiveSheet.Name = MySheetName Sheets("原本").Range("A1:K73").Copy Sheets("1原本").Range("A1") End Sub シートにグラフを乗せたらエラーが出たのですが 解除できないでしょうか?

  • マクロを使ってハイパーリンクを作りたい

    エクセルで下記作業をマクロで行いたいのですが、 途中までつくれたのですが、うまくいきません (1)sheet2をコピーしてsheet2(2)を作る (2)sheet2(2)のsheet名を任意の名前(例222)にかえる (3)sheet1の任意のセルから新しく作った222へハイパーリンクを張る 下記のようなマクロを作りましたが ハイパーリンクを張るとことでうまく行きません どうすればよいのでしょうか。。。 助けてください sub 新しいシートの追加() 'dim sheet名 as string シート名 = InputBox("新しいシート名を入力してください", "シート名の指定") If シート名 <> "" Then Sheets("Sheet2").Select Sheets("Sheet2").Copy After:=Sheets("Sheet2") ActiveSheet.Name = シート名 Sheets("Sheet1").Select Range("A3").End(xlDown).Offset(1).Select ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _ シート名 TextToDisplay:=シート名 Selection.Hyperlinks(1).SubAddress = シート名 End If End Sub

  • エクセルのマクロを使って・・・

    見積書を作成するマクロを作っているのですが、シートの追加がうまくいかず困っています。 見積書を作る際に、明細を入力する行が足らない時に、あらかじめ、作ってある『明細マスター』と言う名前のシートから、明細書をコピーして新しいシートを挿入して、そこに貼り付けると言う作業を、最大で“明細書(1)~(5)”5枚のシートを追加できる…と言う、マクロを作りたいのですが… 追加する枚数はその都度、違うそうなので、1回実行すると、『明細書(1)』が追加され、2回目の実行で『明細書(2)』が追加・・・・・ と言うようなマクロを作りたいのですが・・・ Sub 明細書() Worksheets.Add After:=ActiveSheet ActiveSheet.Name = "明細書(1)" Sheets("明細マスター").Select Cells.Select Selection.Copy Application.CutCopyMode = False Selection.Copy Sheets("明細書(1)").Select Cells.Select ActiveSheet.Paste Range("B2").Select End Sub 上記のマクロで、一枚だけの追加だと明細書が追加されるんですが、それを最大5枚まで追加すると言うマクロが分かりません。 質問が、分かりにくかったら申し訳ありませんが、よろしくお願いいたします。

  • エクセルでのマクロでのループ処理について

    お世話になります。 エクセルのシートにAAA、BBB、0001,0002,0003…というシートがあり ます。 0001、0002…は連番で最大で0050までありますがシート数は変化します。 この連番のシートの名前をそれぞれのシートのH8セルに記入されている テキストと同じ文字にしたいのですが。 シートの名前の変更マクロは検索して見つけたのですがループさせる 方法がわかりません。 Sheets("0001").Select For i = 1 To 100 sName = Format(i, "0000") ActiveSheet.Name = Worksheets("sName").Range Dim シート名 As String シート名 = Range("h5").Value If シート名 = "" Then Exit Sub End If ActiveSheet.Name = シート名 Next 「0001シートから初めて次に0002シート0003シートと変更し シートが見つからない時は変更を終わる。」 というように書ければいいのかなと思います。 上記の様だと0002シートへ移りません。 あまり詳しくないのでWEB検索したコードを書き足してみました。 修正箇所をご指摘頂ければ助かります。 宜しくお願いします。

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

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

  • VBAでシートが追加されたタイミングで動かしたい

    いつもお世話になっております。 掲題の通り、マクロが動くタイミングを、 そのファイルにシートが追加されたときに自動で動くように したいのですが、どのようにしたらいいでしょうか。 具体的に言うと、シートを追加すると、そのシート名を自動で セルの値から取得し、変更してほしいのですが…。 今は以下のように作っています。 Sub シート名変更() Range("N3") = "=VLOOKUP($I$9,Sheet1!$V$2:$W$22,2,0)" ActiveSheet.Name = ActiveSheet.Range("N3") End Sub 申し訳ありませんがご教授いただけたら幸いです。 宜しくお願い致します。