指定シートの有無を確認するVBAでうまく作動しない問題

このQ&Aのポイント
  • VBAを使用して指定したシートの有無を確認する処理を作成していますが、うまく動作していません。指定したシートが存在するかどうかを確認し、存在しない場合は別のシートをコピーして表示する処理です。
  • 処理の流れとしては、指定したシート名を変数に格納し、エラーハンドリングを用いてシートが存在するかどうかを確認します。存在する場合はメッセージを表示し、存在しない場合は別のシートをコピーして表示します。
  • しかし、現在の処理ではうまく動作しておらず、シートが存在しているにもかかわらず存在しないと判定されるなどの問題が発生しています。正しいシートの有無を確認するためには、どのような修正が必要でしょうか?
回答を見る
  • ベストアンサー

指定シートの有無を確認

指定したシートの有無を確認するVBAを作っているのですがうまく作動しません。 Sub dummy() Dim dummy Dim sheetname As String sheetname = Sheets("入力").Cells(1, 1).Value '←『入力』というシートのセルA1と同じ値のシート名 On Error Resume Next Set dummy = sheetname If Err.Number = vbnomal Then flag = True On Error GoTo 0 If flag Then Msgbox "シートがあります" Else Sheets("原紙").Copy before:=Sheets(1) Worksheets(1).Name = sheetname End Sub 補足:入力というシートのA1に値が入っており、その値と同じシートがあればメッセージが出る、無ければ『原紙』というシートをコピーしてコピーしたシートのタブにA1の値を表示する

  • hrgc
  • お礼率47% (10/21)

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

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

参考に Dim sheetname As String Dim sh As Worksheet sheetname = Sheets("入力").Cells(1, 1).Value On Error Resume Next Set sh = Worksheets(sheetname) On Error GoTo 0 If Not sh Is Nothing Then MsgBox sheetname & "は、有ります。", vbInformation Else Sheets("原紙").Copy before:=Sheets(1) Worksheets(1).Name = sheetname End If

hrgc
質問者

お礼

ありがとうございました。 思いどおりになりました。

その他の回答 (1)

  • myRange
  • ベストアンサー率71% (339/472)
回答No.2

>Dim sheetname As String >Set dummy = sheetname Sheetnameはただの文字列なので   Set dummy = Sheets(sheetname) としないといけない。   変数flagもErr.numberを利用すると不要になります。 で、質問者のコードをそのまま使うとすると。。  '-------------------------------------- Sub Test()   Dim Dummy As Worksheet '●ちゃんと型宣言する   Dim SheetName As String   SheetName = Sheets("入力").Cells(1, 1).Value   On Error Resume Next   Set Dummy = Sheets(SheetName)     If Err.Number = 0 Then       MsgBox "シートがあります"     Else       Sheets("原紙").Copy Before:=Sheets(1)       Sheets(1).Name = SheetName     End If   On Error GoTo 0 End Sub '--------------------------------------- 以上です。

hrgc
質問者

お礼

ご親切な対応ありがとう御座いました。 スムーズに解決いたしました。

関連するQ&A

  • Select Case について

    Sub dummy() Dim Dummy As Worksheet Dim SheetName As String Dim i As Integer Dim GEN As Long Dim OTA As Long With Sheets("入力") '3行目~22行目まで For i = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) 'もしシートがあれば・・・ If Err.Number = 0 Then Select Case .Cells(i, 14).Value Case "TK-001" OTA = Sheets("TK-001").Range("B65536").End(xlUp).Row + 1 Sheets("TK-001").Range("B" & OTA).Value = .Cells(i, "H").Value Sheets("TK-001").Range("I" & OTA).Value = .Cells(i, "I").Value Sheets("TK-001").Range("F" & OTA).Value = .Cells(i, "K").Value Sheets("TK-001").Range("G" & OTA).Value = .Cells(i, "L").Value Sheets("TK-001").Range("J" & OTA).Value = .Cells(i, "M").Value End Select 'シートが無ければ・・・ Else '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next End With On Error GoTo 0 End Sub 上記の通りマクロを組みましたが、以下の事を行うのに悩んでいます。 (1)Select Case が100通りあるのですが、全てCaseを入れるのではなく  もっと簡単な方法はありますか?  ※『リスト』シートを作っており、B1~B100までcaseになるコードが入力されています。  例:   B    1  TK-001    2  TK-002    3  TK-003        ・        ・        ・   100   TK-100 というシートを作っています。 (2)今のマクロではどんな値でもシートがなければシートを作ってしまう状態ですが、  もし『リスト』シートの中に値があればシートを作る、無ければ作らないというマクロは可能ですか  

  • Excel VBA 指定シートの有無確認

    指定した名前のシートがあるかないか判断させてますが、 以下のやりかたでは、 グラフ作成したシートを認識してくれません。 そのようにすれば良いでしょうか? Dim ws As Worksheet, flag As Boolean For Each ws In Worksheets If ws.Name = "シート" Then flag = True  Next ws If flag = True Then  msgbox "あります  Else  Sheets.Add  ActiveSheet.Name = "シート" End If

  • VBAの転記について

    With Sheets("入力") '3行目~22行目まで For i = 5 To 24 SheetName = Sheets("入力").Cells(i, "C").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, "C").Value U最終行 = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 If U最終行 = 39 Then Sheets(SheetName2).Copy BEFORE:=ActiveSheet Sheets(SheetName).Delete End If If Err.Number = 0 Then A = Sheets(SheetName2).Range("C65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("C" & A).Value = .Cells(i, "G").Value Sheets(SheetName2).Range("D" & A).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("E" & A).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("F" & A).Value = .Cells(i, "N").Value Sheets(SheetName2).Range("G" & A).Value = .Cells(i, "P").Value Sheets(SheetName2).Range("H" & A).Value = .Cells(i, "R").Value Sheets(SheetName2).Range("I" & A).Value = .Cells(i, "T").Value Sheets(SheetName2).Range("K" & A).Value = .Cells(i, "V").Value Sheets(SheetName2).Range("L" & A).Value = .Cells(i, "X").Value ElseIf .Cells(i, "C").Value <> "" Then G = Sheets("原紙").Range("C65536").End(xlUp).Row + 1 Sheets("原紙").Range("B1").Value = .Cells(i, "D").Value Sheets("原紙").Range("B4").Value = .Cells(2, "D").Value Sheets("原紙").Range("C" & G).Value = .Cells(i, "G").Value Sheets("原紙").Range("D" & G).Value = .Cells(i, "I").Value Sheets("原紙").Range("E" & G).Value = .Cells(i, "L").Value Sheets("原紙").Range("F" & G).Value = .Cells(i, "N").Value Sheets("原紙").Range("G" & G).Value = .Cells(i, "P").Value Sheets("原紙").Range("H" & G).Value = .Cells(i, "R").Value Sheets("原紙").Range("I" & G).Value = .Cells(i, "T").Value Sheets("原紙").Range("K" & G).Value = .Cells(i, "V").Value Sheets("原紙").Range("L" & G).Value = .Cells(i, "X").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName End If Next i End With On Error GoTo 0 上記のVBAを作成しましたが、 C行の値ごとの転記(G~Xの値)が出来ません。 どこが間違いか教えていただけないでしょうか。

  • DBシートの内容をマクロで台帳にしたい

    マクロ初心者です。 エクセルのDBシートの内容をマクロで台帳にしたいのですが、マニュアル本を見てもなかなかうまくできません。 基本的には「DB」シートと、台帳原紙シートからなるエクセルファイルがあります。 「DB」シートのA列 A4:A500には商品の記号がならび、B列以降はその行の商品の固有情報が記載されています。  例 A7  商品αの記号   B7  商品αの項目  C7商品αの仕様・・・ 台帳原紙シートは空欄の商品台帳となっております。 DBシートのA列の任意のセル(例 A14 記号名 「TEST-8」)を選択し、マクロを開始すると、台帳原紙シートをコピーして、そのシート名を「TEST-8」とし、台帳「TEST-8」のセルD1にDBシートのB7の記載情報をコピー。同じく台帳「TEST-8」のセルD5にDBシートのH7の記載情報をコピーしたいのです。  なお、マクロを開始した際、すでに記号名と同じ名称のシートがある場合は、コピーせず、そのシートに飛ぶようにしたいと考えております。 Sub DB⇒台帳() Dim Sheetname As String On Error GoTo Er1 Sheetname = Cells(ActiveCell.Row, 5) If Sheetname <> "" Then Sheets("Orig.Sheet1").Select Sheets("Orig.Sheet1").Copy Before:=Sheets(3) End If Er1: End Sub と見よう見真似でやってみたものの、既存のシートには飛べましたが、結果は散々・・・。 いろいろご指導をお願い申し上げます。

  • 最終シートからその手前まで5シートの選択したい

    最終シート名が「基本」、その前が「種別」、さらにその前が「一覧」と言うシート名になっています。 またその「一覧」の前2ケは、シート名をindexで指定したいです。 以下のコードを実行してもうまく、シートを除外してくれません。どうしたらよろしいでしょうか。 Sub 各シートに関数を入力() Dim EXCEPT_NAME As String EXCEPT_NAME = " 一覧  種別  基本" & Worksheets(Sheets.Count - 4).name & Worksheets(Sheets.Count - 5).name Application.ScreenUpdating = False ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path Dim list, sheetName For Each sheetName In ActiveWorkbook.Worksheets If InStr(EXCEPT_NAME, sheetName.name) = 0 Then Sheets(sheetName.name).Activate ActiveSheet.Unprotect Call 関数貼付 End If Next End Sub

  • Excel VBA セルの値をシート名にしたいのです。

    こんばんは 新しくシートを挿入させて、「シート2」の値のみをコピーさせたいと考えています。 その新しく挿入させたシート名を「シート1」のせるA3とA4の文字列をあわせたものにしたいのですが、どうしたらよいのでしょうか。 途中まで考えたところでいきずまってしまいました。 どうか英知をお貸しください。 宜しくお願い致します。 A3には日付、A4には名前が入力されています。 Dim sheetName As String Worksheets("月度集計").Activate Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = Worksheets("Sheet1").Cells(3, 3).Value On Error Resume Next Worksheets(1).Name = sheetName On Error GoTo 0 Range("f2").Select

  • Next,End Withのエラー

    Sub 入力() If Sheets("入力").Range("D3").Value = "" Then MsgBox "客先名を入力して下さい" Else Dim K最終行 As Long Dim T最終行 As Long Dim i As Integer With Sheets("入力") For i = 3 To 12 If .Cells(i, "H").Value <> "" Then U最終行 = Sheets("注文書").Range("G65536").End(xlUp).Row + 1 If U最終行 = 461 Then MsgBox "注文書がいっぱいです" Exit Sub Else End If E最終行 = Sheets("営業確認").Range("G65536").End(xlUp).Row + 1 Sheets("営業確認").Range("k" & E最終行).Value = .Cells(i, "b").Value Sheets("営業確認").Range("b" & E最終行).Value = .Cells(i, "c").Value Sheets("営業確認").Range("c" & E最終行).Value = .Cells(i, "d").Value Sheets("営業確認").Range("d" & E最終行).Value = .Cells(i, "e").Value Sheets("営業確認").Range("g" & E最終行).Value = .Cells(i, "h").Value Sheets("営業確認").Range("f" & E最終行).Value = .Cells(i, "i").Value Sheets("営業確認").Range("i" & E最終行).Value = .Cells(i, "m").Value Sheets("営業確認").Range("h" & E最終行).Value = .Cells(i, "p").Value Else End If Select Case .Cells(i, "o").Value Case "北" K最終行 = Sheets("北").Range("h65536").End(xlUp).Row + 1 Sheets("北").Range("B" & K最終行).Value = .Cells(3, "C").Value Sheets("北").Range("c" & K最終行).Value = .Cells(3, "b").Value Case "中" T最終行 = Sheets("中").Range("H65536").End(xlUp).Row + 1 Sheets("中").Range("b" & T最終行).Value = .Cells(3, "c").Value Sheets("中").Range("c" & T最終行).Value = .Cells(3, "b").Value End Select Exit Sub Dim Dummy As Worksheet Dim SheetName As String Dim OTA As Long Dim GEN As Long Dim SheetName2 As String With Sheets("入力") '3行目~22行目まで For j = 3 To 22 SheetName = Sheets("入力").Range("D3").Value On Error Resume Next Set Dummy = Sheets(SheetName) SheetName2 = .Cells(i, 14).Value 'もしシートがあれば・・・ If Err.Number = 0 Then 'SheetName2は入力シートのN行 SheetName2 = .Cells(i, 14).Value OTA = Sheets(SheetName2).Range("B65536").End(xlUp).Row + 1 Sheets(SheetName2).Range("A7").Value = .Cells(3, "D").Value Sheets(SheetName2).Range("C3").Value = .Cells(3, "C").Value Sheets(SheetName2).Range("B" & OTA).Value = .Cells(i, "H").Value Sheets(SheetName2).Range("I" & OTA).Value = .Cells(i, "I").Value Sheets(SheetName2).Range("F" & OTA).Value = .Cells(i, "K").Value Sheets(SheetName2).Range("H" & OTA).Value = .Cells(i, "L").Value Sheets(SheetName2).Range("J" & OTA).Value = .Cells(i, "M").Value 'シートが無ければ・・・ Else GEN = Sheets("原紙").Range("B65536").End(xlUp).Row + 1 Sheets("原紙").Range("A7").Value = .Cells(3, "D").Value Sheets("原紙").Range("C3").Value = .Cells(3, "C").Value Sheets("原紙").Range("B" & GEN).Value = .Cells(i, "H").Value Sheets("原紙").Range("I" & GEN).Value = .Cells(i, "I").Value Sheets("原紙").Range("F" & GEN).Value = .Cells(i, "K").Value Sheets("原紙").Range("H" & GEN).Value = .Cells(i, "L").Value Sheets("原紙").Range("J" & GEN).Value = .Cells(i, "M").Value '原紙をコピーする Sheets("原紙").Copy BEFORE:=Sheets(1) 'シートの名前を市場コードにする Sheets(1).Name = SheetName Next End With Exit Sub On Error GoTo 0 Sheets("原紙").Select Range("C3:E3,A7,B16:B35,F16:F35,H16:J35").Select Range("H35").Activate Selection.ClearContents Sheets("入力").Select Sheets("入力").Range("D3,G3:J12,L3:M12").Value = "" Sheets("入力").Range("D3").Select Range("B3").Formula = "=IF(D3="""","""",VLOOKUP(D3,'\\Seika-sv01\支店共有\マーケティング用\[担当者リスト.xls]リスト形式'!$B:$D,3,FALSE))" MsgBox "入力が完了しました" End If End Sub 上記のようにマクロを組みましたがエラーが出てしまいます。

  • 指定記号のみ別シートにコピー

    sheet1(表-1)の入力文字「A,C,E」をsheet2へコピーする。 sheet2(表-3)のように[A,C,E」以外及びsheet1空白のセルはsheet2でも空白としたい。 その際、sheet2(表-2)に入力済みの記号「○、●、◎」はそのまま残したい。 下記のコードでは、sheet2に入力済みの記号「○、●、◎」が消えてしまいます。 どなたかコードがわかる方よろしくお願いします。 Sub シートコピー() Dim r As Range For Each r In Worksheets("Sheet1").Range("B1:D5") If WorksheetFunction.CountIf(Range("A8:A10"), r.Value) Then Sheets("sheet2").Range(r.Address).Value = r.Value Else Sheets("sheet2").Range(r.Address).Value = "" End If Next End Sub セルA11に"0"を入力して実行してもsheet1空白セルはsheet2でも空白となり困っています。

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

    初めて質問するのですが、エクセルで原紙シートのマクロまで全てをコピーして新規のシートを作成させるにはどうしたらいいですか? 新規のシートの特定のセルに入力した時に新規シートが作成されるようにできますか? 原紙は 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 のマクロが現在できあがってます。これを残しつつできますか?よろしくお願いします!

  • 特定のシートだけ関数入力を除外したい

    windows7 Excel2007でマクロ作成中の初心者です。 30枚のシートがあるブックがあります。 以下のコードで処理を行っていました。 Sub 請求書入力() Const EXCEPT_NAME = "表紙 経理 一覧  部門" Application.ScreenUpdating = False ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path Dim list, SheetName For Each SheetName In ActiveWorkbook.Worksheets If InStr(EXCEPT_NAME, SheetName.Name) = 0 Then Sheets(SheetName.Name).Activate Call 各シートに同じ関数を入れる End If Next End Sub しかし、上のシートの前にある2枚のシートだけ関数を入れないようにしたいです。この2枚だけはシート名が可変のため除外シートに追加できません。 また、それより、前のシートはシート数が可変で15から20枚あります。 そのためには、どういうコードにしたらよろしいでしょうか。

専門家に質問してみよう