• ベストアンサー
  • 困ってます

ブック内に特定名のシートがある場合

はじめまして、こんにちは。 VBAを最近はじめたばかりの者です。質問が初歩的なもので申し訳ないのですが是非教えてください。 以下を使って、複数ブックの○○というシートから指定セルの内容を抜き出したいと思っています。 ところが、ブックによっては○○というシートが存在しない場合があり、その場合には「インデックスが有効でない」というエラーで動作が止まってしまいます。 ブック内に○○というシートがある場合にのみ動作させるようにするにはどのようにすれば良いのでしょうか。 よろしくお願いします。 Dim wb As Workbook, myRow As Long Dim e As Integer myRow = ThisWorkbook.Worksheets(1).Rows.Count With Application.FileSearch .NewSearch .LookIn = ThisWorkbook.Path .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For i = 1 To .FoundFiles.Count If .FoundFiles(i) <> ThisWorkbook.FullName Then Set wb = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0) Application.ScreenUpdating = False ThisWorkbook.Worksheets(1).Range("A" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F6").Value ThisWorkbook.Worksheets(1).Range("B" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F7").Value ThisWorkbook.Worksheets(1).Range("C" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("F8").Value ThisWorkbook.Worksheets(1).Range("D" & myRow).End(xlUp).Offset(1, 0).Value = _ wb.Worksheets("○○").Range("Y6").Value wb.Close False End If Next i Else MsgBox "ファイルがありません。" End If End With End Sub

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

  • 回答数2
  • 閲覧数115
  • ありがとう数3

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

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

On Error Resume Next にして、エラーが起きても無視して次の処理を行うようにするとか。

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

質問者からのお礼

ありがとうございます、これは目からウロコでした!!

その他の回答 (1)

  • 回答No.1

Dim ws As Worksheet For Each ws In wb.Worksheets If ws.Name = "○○" Then ' 処理ごにょごにょ End If Next とか?

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

質問者からの補足

質問する前に一度その方法を試してみたのですが、うまく動作しないのです。入れる所が間違っているのでしょうか? Dim wb As Workbook, myRow As Long Dim e As Integer Dim ws As Worksheet myRow = ThisWorkbook.Worksheets(1).Rows.Count With Application.FileSearch .NewSearch .LookIn = ThisWorkbook.Path .SearchSubFolders = True .FileType = msoFileTypeExcelWorkbooks If .Execute() > 0 Then For Each ws In wb.Worksheets If ws.Name = "○○" Then For i = 1 To .FoundFiles.Count If .FoundFiles(i) <> ThisWorkbook.FullName Then Set wb = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0) Application.ScreenUpdating = False '動作中略 wb.Close False End If End If Next Next i Else MsgBox "ファイルがありません。" End If End With End Sub この状態だと、Forに対するiが無いと出ます。

関連するQ&A

  • 各ブックの集計値を自動的に他のブックに総合計として表示させたい。

    エクセルで各ブックの集計値を他のブックに集計したいのですが、フォルダを移動させると数値が違ってしまう。どうすればいつ見ても正しい集計値を見れるか教えて下さい。 現在1つのファイルの中にある、ブック1・2・3にそれぞれ数値を入力して合計値をブック3の別シートに合計表示させていますが、同じブックのシート間の集計ではないため、毎回数値が変わってしまい、その都度計算式を(=ブック1 D60+ブック2 d80+・・・など)を入れなおしています。 間違いなく集計できる方法を教えて下さい。ちなみに全くの初心者なので細かく説明していただけると有難いです。 VBAで検索して下記を見つけ、セル範囲やシート名など変更して試してみましたが、内容がよくわからないため 変な数字がでてきました。初心者にはやはり無理でしょうか? Sub Test() Dim MyName As String, wb As Workbook On Error Resume Next MyName = Dir(ThisWorkbook.Path & "\*.xls", vbNormal) Do While MyName <> ""   If UCase(MyName) <> UCase(ThisWorkbook.Name) Then    Application.ScreenUpdating = False    Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & MyName)    ThisWorkbook.Worksheets("Sheet1").Range("A65536").End(xlUp) _      .Offset(1, 0).Value = wb.Worksheets("物件").Range("d90:k90").Value    wb.Close   End If   MyName = Dir Loop Application.ScreenUpdating = True End Sub

  • エクセルVBA の変数を使うべきでしょうか?

    はじめまして。エクセル初心者です。 書籍やサイトで勉強させてもらっていますが、VBAがなかなか難しくてすぐに壁にぶつかってしまいます。少々困ってしまい、詳しい方のアドバイスを頂ければと質問を投稿させていただきました。 どうか宜しくお願い致します。質問ですが、 以下のようなコードで、sheet5のB列の任意のセルをダブルクリックした場合、sheet5のBCD列の同じ行のセル値がsheet1の指定した列に入力されるという処理を作りました。 これで一応目的の動作はするのですが、数が増えると「コンパイルエラー・プロシージャが大きすぎます」というメッセージがでてしまいます。列や行には規則性があるので、もしかしたら変数というものを使ってコードを書き直せばいいのかなと思いネットで調べてみたのですが、今のところさっぱり理解できません。 申し訳ありませんが、分かりやすくご教授いただけないでしょうか。バージョンは2003を使っています。 また、下のコードですと、sheet5のBCDいずれかのセルに空白があった場合、sheet1の列に入力されるときに入力される行がずれてしまいます。今は空白を何かで埋めて対処しているのですが、この問題の解決策も教えて頂けると助かります。どうか宜しくお願い致します。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, cancel As Boolean) If Target.Address = "$B$2" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B2") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C2") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D2") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$3" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B3") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C3") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D3") Worksheets("sheet1").Activate cancel = True End If If Target.Address = "$B$4" Then Worksheets("sheet1").Range("B" & Rows.Count).End(xlUp).Offset(1).Value = Target.Value Worksheets("sheet1").Range("H" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("B4") Worksheets("sheet1").Range("K" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("C4") Worksheets("sheet1").Range("M" & Rows.Count).End(xlUp).Offset(1).Value = Worksheets("sheet5").Range("D4") Worksheets("sheet1").Activate cancel = True End If   ・     ・   ・     ・   ・     ・ End Sub

  • 【VBA】複数のブックを1つのシートにまとめる

    あるフォルダ内に複数のブックが入っており、新しいブックに1シートでまとめようとしております。 フィルターを使用すればよいのかもしれませんが、マクロを使用したいです。 (1)全て同じフォーマットである (2)全てA17から数値が入力されているので、16行目まではフォーマットを残し、A17行目以降K列までをコピーして結合したい Sub 結合() '結合したいファイルがあるフォルダの場所 cドライブなら "C:\test\" Const Fol As String = "C:\test\" Dim Fn Dim NewFile As Workbook Dim Wb As Workbook Dim Ws1 As Worksheet Dim R As Range Set NewFile = Workbooks.Add Set Ws1 = NewFile.Worksheets(1) Set R = Ws1.Range("A17") Fn = Dir(Fol, vbNormal) Do Until Fn = "" Set Wb = Workbooks.Open(Fol & Fn) 'ワークシート1をコピーする場合は Wb.Worksheets(1) Set Ws1 = Wb.Worksheets(1) 'タイトル行を設定 If ck = False Then For cnt = 1 To 4 Wb.Worksheets(cnt).Range("A1:J16").Copy Destination:=NewFile.Worksheets(cnt).Range("A1") Next cnt ck = True End If For cnt = 1 To 4 Set Ws1 = NewFile.Worksheets(cnt) Set Ws2 = Wb.Worksheets(cnt) R = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1 With Ws2 End With Next 'A17行目からコピーして結合する(→本当はA17行目~K列までを反映したい) Ws2.Range("A17", Ws2.Cells(Rows.Count, 3).End(xlUp)).Resize(, 20).Copy R If R.Offset(1).Value = "" Then Set R = R.Offset(1) Else Set R = R.End(xlDown).Offset(1) End If Wb.Close 'Debug.Print Fn Fn = Dir Loop Set R = Nothing Set Ws1 = Nothing: Set Ws2 = Nothing Set Wb = Nothing: Set NewFile = Nothing End Sub マクロは触ったことない初心者でグーグル検索をしながら作ってみました。 一応実行するとエラーは出ないのですが、結合されたリストが飛び飛びで、理由がわかりません。 どなたかおわかりになりますでしょうか・・・。

  • シートの増減あっても特定セルに連番したい

    Excel2007でマクロ作成の初心者です。 すべてのシートのR15セルに、シートの順番どおり 1から連番で番号をつけるマクロを教えていただきました。 Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim i As Integer For i = 1 To ThisWorkbook.Worksheets.Count Worksheets(i).Range("R15").Value = i Next i End Sub これを以下のように改良したのですが、新しく追加したシートにはなぜか 番号が表示されません。どうしたら、うまく連番が入るようになるでしょうか。 Sub シートに連番() Dim i As Integer For i = 1 To ThisWorkbook.Worksheets.Count Worksheets(i).Range("R15").Value = i Next i End Sub

  • 他のブックでマクロを実行するには?

    以下のマクロを実行すると同一ブック内の他のシートに入力 されますが、これを他のブックのシートに入力されるように するには、具体的にどのようにすればいいのでしょうか? ご教授ください。 ---------------------------------------------------------------- Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • 別ブック間のすべてのシートのある列を比較

    こんにちは、 エクセルvba超初心者で修行中のものです。 別ブック間のすべてのシートのある列を比較し、同じ値に色を付けるというマクロを 作りたいのですが、 下記のようにシートを限定する→With Workbooks("マクロ1.xls").Sheets("Sheet1") とうまくいくのですが、それぞれのブックのすべてのシートに対して比較をしたいので With Workbooks("マクロ1.xls").worksheets と書くと コンパイルエラー、メソッドまたはデータメンバーが見つかりません と出てきてSet search1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)) このなかの左から二つ目のRangeの色が反転します。 vba に関する勉強不足は重々承知しておりますが、意味が理解できません。 どうすれば、シート全体を検索できるようになるのでしょうか? ぜひお力をお貸しください よろしくお願いいたします。 Sub search() Dim search1 As Range, search2 As Range, s As Range, ss As Range With Workbooks("マクロ1.xls").Sheets("Sheet1") Set search1 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)) End With With Workbooks("まくろ2.xls").Sheets("Sheet1") Set search2 = .Range(.Range("i2"), .Range("i" & Rows.Count).End(xlUp)) End With For Each s In search1 For Each ss In search2 If s.Value = ss.Value Then s.Interior.ColorIndex = 6 ss.Interior.ColorIndex = 6 End If Next ss Next s End Sub

  • 複数のブックの特定シートを1つのブックにまとめたい

    複数のブックの特定のシートを1つのブックにまとめたいのですが そのマクロは下記のように検索してでてきたのですが Sub test() Dim Fname As String Dim Wbm As Workbook Dim Wbs As Workbook Application.ScreenUpdating = False Set Wbs = ThisWorkbook Fname = Dir(ThisWorkbook.Path & "\*.xlsx*") Do While Fname <> "" If Fname <> ThisWorkbook.Name Then Workbooks.Open ThisWorkbook.Path & "\" & Fname Set Wbm = ActiveWorkbook Wbm.Worksheets("2016.03").Copy after:=Wbs.Worksheets(Wbs.Worksheets.Count) ActiveSheet.Name = Left(Fname, InStr(Fname, ".") - 1) Wbm.Close End If Fname = Dir() Loop Application.ScreenUpdating = True End Sub たとえば、特定のシートというのが毎回変わる場合今回は”2016.03"ですが 次回は”2016.04”という風に変わる時、どこかに入力したセルの値を元にシートを検索してくることなどは可能なのでしょうか? よろしくお願い致します。

  • 全部の列でSelection.NumberFormatLocal = "0.00"になってしまう

    以前こちらでお世話になった者です。 教えていただいたコードを応用したのですが、うまくいきません。 以下のようにすると、最後にすべての列の数値が0.00の形になってしまいます。 どこが悪いのか教えてください。よろしくお願いします。 Sub data_torikomi9_1() Dim wb As Workbook Dim Fn As String Dim myPath As String Dim dbBkSh As Worksheet Dim i As Long For Each wb In Workbooks If wb.Name <> ThisWorkbook.Name And _ InStr(1, wb.FullName, "form\", 1) > 0 Then 'formを検索 wb.Close '閉じる End If Next wb myPath = ThisWorkbook.Path & "\" Set dbBkSh = ThisWorkbook.Worksheets("様式9-1") With dbBkSh.UsedRange If .Cells(.Cells.Count).Row > 10 Then .Range("A11", .Cells(.Cells.Count)).Clear End If End With Fn = Dir(myPath & "form\*.xls") i = 1 '画面のちらつきを抑える Application.ScreenUpdating = False Do Until Fn = "" If Fn <> ThisWorkbook.Name Then With Workbooks.Open(myPath & "form\" & Fn, , True) '会社名と企業コード dbBkSh.Range("E2").Value = .Worksheets("inputform").Range("C2").Value dbBkSh.Range("B2").Value = .Worksheets("inputform").Range("M2").Value 'A11 - 1 dbBkSh.Range("A10").Offset(i, 0).Value = i 'B11 - 氏名 dbBkSh.Range("A10").Offset(i, 1).Value = .Worksheets("inputform").Range("C7").Value 'C11 - 番号 dbBkSh.Range("A10").Offset(i, 2).Value = .Worksheets("inputform").Range("H29").Value 'D11 - ポイント dbBkSh.Range("A10").Offset(i, 3).Value = .Worksheets("inputform").Range("H32").Value .Close False i = i + 1 End With End If Fn = Dir() Loop Columns("B:C").Select Selection.HorizontalAlignment = xlLeft Columns("C:C").Select Selection.NumberFormatLocal = "00000" Columns("A:A").Select Selection.HorizontalAlignment = xlCenter Columns("D:D").Select Selection.NumberFormatLocal = "0.00" Range("A6").Select Application.ScreenUpdating = True Set dbBkSh = Nothing End Sub

  • 全く作動しないです。(転記しないです。)

    Private Sub CommandButton1_Click() If CheckBox1 = xlOn Then Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) .Value = "新規" ElseIf CheckBox1 = xlOff Then Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1) .Value = "リピート" End If End Sub 上記のようなコードですが、まったく作動しないです。 どこが間違っているのでしょうか。

  • シートを他のブックに貼付けたい

    Excel2007でマクロ作成中の初心者です。 やりたいことは 1)本ブックの中の「当月売上」シートを他ブックに貼付けたいです。 2)他ブックに貼り付けた「当月売上」シート名は、セルK1の日付に変更したいです。 すると、他ブックのシートが毎月順に、売上(2012年4月) 売上(2012年5月) 売上(2012年6月)というふうに増えます。 3)何月に作成しても、ブックの「当月売上」シートを貼り付けます。 四苦八苦して以下のコードをつくりましたが、「同じ名前のシート名に変更できません。」 というエラーがでるので、このエラーが出ないように、名前が同じ時は上書き保存し、違うときは新しいシート名を作るという コードにしたいです。困ってます。どうかご指導お願いします。 Sub 売上シートの貼付け() Dim WBK1 As Workbook ' 本ブックの Dim WBK2 As Workbook ' 貼付け先他ブック ChDir ThisWorkbook.Path + "\売上" On Error Resume Next Set WBK2 = Workbooks("24年度売上.xls") On Error GoTo 0 If WBK2 Is Nothing Then Set WBK2 = Workbooks.Open(ThisWorkbook.Path & "\売上\24年度売上.xlsm") End If Worksheets("当月売上").Copy After:=Workbooks("24年度売上.xlsm").Sheets(Workbooks("24年度売上.xlsm").Sheets.Count) ActiveSheet.Name = Format(Range("K1").Value, "売上(yyyy年mm月)") Application.DisplayFormulaBar = True WBK2.Close SaveChanges:=True Application.DisplayAlerts = True Set WBK2 = Nothing End Sub