ワークブックを開くマクロが動かない！エラー424が発生する理由とは？

前へ 次へ
このQ&Aのポイント
  • D列7行目のセル以降に記入したワークブックを次々と開きたいと思い、マクロを書いてみたのですが、実行時エラー424、オブジェクトが必要ですとのメッセージが出力され、ブックが開きません。
  • エラー424はオブジェクトが必要な状態でオブジェクトが指定されていないことを意味しています。マクロのコードを確認してみてください。特に、変数の宣言やセル番号の指定などが正しく行われているかチェックしましょう。
  • また、ファイルのパスやシート名なども正しく指定されているか確認しましょう。ファイルが存在しない場合やシート名が間違っている場合にもエラーが発生することがあります。修正が必要な部分を見つけ出し、適切なオブジェクトを指定してください。
回答を見る
  • ベストアンサー

ワークブックを開くマクロが動きません。

D列7行目のセル以降に記入したワークブックを次々と開きたいと思い、マクロを書いてみたのですが、実行時エラー424、オブジェクトが必要ですとのメッセージが出力され、ブックが開きません。 どこを修正すればよろしいでしょうか？アドバイスを頂けないでしょうか。 　 || D | 7行｜|テスト1｜ 8行｜|テスト2｜ 9行｜|テスト3｜ Sub ワークブックオープン() '■変数設定 Dim Mypath As String, x As Integer, MycelNO As Integer Dim Myworkbook As String, Mybook As String Mypath = ActiveWorkbook.Path '格納フォルダのパスを取得する。 MycelNO = Range("D7").CurrentRegion.Rows.Count 'D列の処理ブックの数を数える。 '■連続実行 '--処理開始----------------------------------------------------------------- For x = 7 To 7 + MycelNO Mybook = Cells(x, 4) Myworkbook = Mypath & "\" & Mybook & ".xls" Workbook.Open Filename:=Myworkbook Next x End Sub

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

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

Workbooks.Open Filename:=Myworkbook こうではなかろうか？

yokoneco
質問者

お礼

あっ！！ どうもありがとうございました。動きました。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • 特定の名前のシートがあるか確認するには

    1つのフォルダの中に ４つのエクセルファイルがあります。 そのエクセルファイルの中に12というファイル名がある場合は メッセージを出したいと考えて以下のコードを書きました。 この４つのファイルのうち1つのファイルに12のシートを 存在させてみて、以下のコードで実行しました。 Sub シートの確認2() Const MyPath As String = "C:\test\" Dim MyBook As Workbook Dim MyFileName As String Dim MyRng As Range Dim i As Long Dim ws As Worksheet, flag As Boolean MyFileName = Dir(MyPath & "*.xlsx") Do While MyFileName <> "" If ThisWorkbook.Name <> MyFileName Then Set MyBook = Workbooks.Open(MyPath & MyFileName) For i = 1 To Worksheets.Count If Worksheets(i).Name <> "12" Then MsgBox "[12]シートが存在しません。" Else MsgBox "[12]シートが存在します。" End If Next i MyBook.Close End If MyFileName = Dir() Loop End Sub すると、 12という名前のあるシートを持つブックの場合、 "[12]シートが存在しません。" "[12]シートが存在します。" の両方のメッセージが出てきます。 おそらく考えるに そのブックにはシートが２枚あり、 そのうち１つが12という名前のシートであり もう一つは違う名前なので このような現象が出てくるのではないかと。 ただ単純に、その同一フォルダ内のブックに12というがあるかないかを 取得するにはどうしたらよいでしょうか？

  • 一部マクロを変更したいので教えてください。

    現在、下記のようなマクロを使用しています。 Sub sample() Dim myFile As String, myPath As String, i As Long Application.ScreenUpdating = False myPath = InputBox("フルパスでフォルダーを指定") myFile = Dir(myPath & "\*.xls", vbNormal) Do Workbooks.Open myPath & "\" & myFile For i = 1 To ActiveWorkbook.Sheets.Count If WorksheetFunction.CountA(Sheets(i).Range("B7:B11")) = 0 Then Sheets(i).Range("B7") = "*" End If Next ActiveWorkbook.Close True myFile = Dir() Loop While myFile <> "" Application.ScreenUpdating = True MsgBox "完了 ！！" End Sub 上から４行目のmyPath = InputBox("フルパスでフォルダーを指定")を パスを入力するマクロではなくてもっと簡単にフォルダを選択するマクロに変更したいのですが どうすればいいですか？

  • VBAで行数を数えてテキストデータにコピーしたい。

    エクセルの実行ボタンを押すとアクティブシートにあるデータのA7から空白までの行数を数えて、その行数と同じ分、テキストデータをSQLテキストファイルにコピーしたいのですが、うまくいきません。 どなたか分かる方教えてください。 出来れば、下記のVBAを生かして組み込みたいです。 よろしくお願いします。 Private Sub CommandButton1_Click() Dim myDate As String Dim myPath As String Dim NewPath As String Dim FNo As Integer Dim Ar(1) As String Dim SqlData As String Dim i As Integer Dim j As Integer '★配列にsqlファイルのタイトルを代入★ Ar(0) = "TEST1.sql" Ar(1) = "TEST2.Sql" '★sqlデータの内容を入れる★ sqlData0 = ActiveSheet.Rows("A7:")(xlDown) * "testdata_a" & Chr(13) & Chr(10) SqlData1 = ActiveSheet.Rows("A7:")(xlDown) * "testdata_b" & Chr(13) & Chr(10) & "testdata_c" myDate = Format(Date, "yyyymmdd") myPath = ThisWorkbook.Path NewPath = myPath & "\" & myDate ↑VBAは省略して途中まで記載しました。

  • エクセル２０００マクロエラー

    下記のマクロを記述を記載していますが Open path + finame For Input As #1→でファイルがありませんという エラーがでます。c:\aa着色加工計画\testにファイル（T_Sort.csv）はあるみたいなのですが 教えてください。何が原因でしょうか Sub Do_shukei() Dim 処方(1) As String, 品名(1) As String Dim 倉庫(1) As String Dim tuki(15) As String, sort(1) As String, st As Integer Dim sihan(8) As Long, zaiko As Long, suryo(15) As Long Dim ryo(6) As Long, a As Integer, i As Integer Dim path As String, finame As String, foname As String st = 1 a = 1 For i = 1 To 15 suryo(i) = 0 Next i path = "c:\aa着色加工計画\test" finame = "T_Sort.csv" foname = "T_shukei.csv" Open path + foname For Output As #2 Open path + finame For Input As #1 Do Until EOF(1) = True If a = 1 Then Input #1, sort(0), 倉庫(0), 処方(0), 品名(0), tuki(1), tuki(2), tuki(3), tuki(4), tuki(5), tuki(6), tuki(7), tuki(8), tuki(9), tuki(10), tuki(11), tuki(12), tuki(13), tuki(14), tuki(15) Write #2, sort(0), 倉庫(0), 処方(0), 品名(0), tuki(1), tuki(2), tuki(3), tuki(4), tuki(5), tuki(6), tuki(7), tuki(8), tuki(9), tuki(10), tuki(11), tuki(12), tuki(13), tuki(14), tuki(15) a = 0 GoTo l 下記省略

  • 複数のブックからデータを転記するマクロについて

    こんにちは。 VBAの素人なのでネットや本などで自分なりに調べましたが、 どうにも解決できないので、ご教示いただけませんでしょうか。 複数のブックにある同一セル番地にある データを別のブックにまとめたいのですが、 ブック数が500程度あり、マクロでうまくできないか悩んでいます。 　(1)転記元ブックを開く。 　(2)転記元データをコピーする。 　(3)転記先ファイルのセルに貼り付ける。 　(4)転記元ブックを閉じる。 の繰り返しだと思うのですが、(2)ができず困っています。 ちなみに、500のブックとまとめるブックも同じフォルダにあります。 具体的には、転記元ブックは以下のような形で、A列に様々な温度のデータが縦に並んでいます。 　　　A列　　 1行　 温度　 2行　　27　←ここのみ抽出したい 3行　　28 4行　　30 それぞれのブックのA2番地の温度データのみを抽出し、転記先ブックのA2からA500までまとめたい。 組んだマクロは以下です。 ------------------------------ Sub 特定フォルダ内ブックを並べ替えて転記() Dim myDir As String, myName As String, myBook As Workbook Dim motodata As Range, sakidata As Range 　 '集計用のブックがあるフォルダ名を指定 myDir = "D:\VBA練習" myName = Dir(myDir & "\" & "*.xls") 　 Do While myName <> "" 　 '↓転記先の最新レコード位置を取得する 　 Set sakidata = Range("A65536").End(xlUp).Offset(1) 　 '↓(1)指定した名前のブックを開いて変数に格納する 　Set myBook = Workbooks.Open(Filename:=myDir & "\" & myName) 　 '↓(2)転記元を取得する 　 Set motodata = myBook.Range("A2") 　 　　　'↓(3)転記先に貼り付ける 　 motodata.Copy sakidata 　 '↓(4)開いたブックを閉じる 　 myBook.Close 　myName = Dir() 　Loop End Sub ------------------------------ mybookというキーワードを使用して、A2セルデータをコピーする構文をご教示いただけませんでしょうか。 以上、長々となってしまいましたが、何卒アドバイスの程お願いいたします。

  • フォルダ内の特定ブックだけを1つのブックにまとめる

    以前こちらで質問させて頂きましたフォルダ内の特定ブックだけを1にのブックにまとめる方法で、大変助かっていましたがブック名が変更になり、教えて頂いたマクロでは実行できなくなったので自分なりに考えたのですがどうしてもできません。 質問時のブック名は「1_****」と「2_****」で 今回「1_****」だけが「1(3)_****」に変更になりました。 下記のマクロでmyfile = dir(mypath & "1_" & "*.xl*")→myfile = dir(mypath & "1(3)_" & "*.xl*")に変更するのはわかるのですが do until myfile = "" 　　myfile2 = "2" & mid(myfile,2,99)をどう変更すれば良いかわかりません どなたかお助け頂けませんか？ sub macro1() 　dim myPath as string 　dim myFile as string 　dim myFile2 as string 　mypath = "c:\test\" 　myfile = dir(mypath & "1_" & "*.xl*") 　do until myfile = "" 　　myfile2 = "2" & mid(myfile,2,99) 　　workbooks.open mypath & myfile 　　workbooks.open mypath & myfile2 　　application.displayalerts = false 　　workbooks(myfile).worksheets("2").delete 　　application.displayalerts = true 　　workbooks(myfile2).worksheets("2").move after:=workbooks(myfile).worksheets("1") 　　workbooks(myfile).close true 　　workbooks(myfile2).close false 　　myfile = dir() 　loop end sub

  • VBA　探しているFileがないときの処理方法

    現在、下記のようにしてマクロ実行ブックと同じ階層のフォルダ名を取得してAに、フォルダ内のabc.XLSのC9の値をBに、abc.XLSの更新日時をCに表示させています。 このとき、フォルダ内にabc.XLSが無い場合にファイル名をAに書き出してB及びCは空白というように表示したいのですが、どのようにすればよろしいでしょうか。 macro1は以前質問させて頂いたものがベースになっています。ExecuteExcel4Macroを使っている関係でファイル名が無いときの処理はDirを使ってできるとmougで調べてわかりましたが、自分の知識ではできず、macro2を作成したのですが、指定ファイルがない場合の処理がうまくできずにいます。 macro1はファイルオープンの窓が開きます。macro2はファイルが存在しないという窓が開きます。 どちらの場合でもかまいませんのでお力をお貸し頂けませんでしょうか。 Sub macro1() Dim myPath As String Dim myFolder As String Dim r As Long r = 3 myPath = ThisWorkbook.Path & "\" myFolder = Dir(myPath, vbDirectory) myBook = "abc.XLS" Application.ScreenUpdating = False Range("A3:C60").Clear Do Until myFolder = "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Cells(r, 1) = myFolder Cells(r, 2).Value = ExecuteExcel4Macro("'" & myPath & myFolder & "\[" & myBook & "]Sheet1 '!R9C3") On Error Resume Next Cells(r, 3) = FileDateTime(myPath & myFolder & "\" & myBook) On Error GoTo 0 If Cells(r, 3) = "" Then Cells(r, 2) = "myBook" End If Cells(r, 2).NumberFormatLocal = "#,##0_ " Cells(r, 3).NumberFormatLocal = "y""年""m""月""" With Range("A3:C60") .Sort Key1:=Range("C3"), Order1:=xlAscending .Borders.LineStyle = True End With r = r + 1 End If End If myFolder = Dir() Loop Application.ScreenUpdating = True End Sub Sub Macro2() Dim myPath As String Dim myFolder As String Dim myBook As String myPath = ThisWorkbook.Path & "\" myFolder = Dir(myPath, vbDirectory) myBook = "abc.XLS" i = 2 Do Until myFolder = "" If myFolder <> "." And myFolder <> ".." Then If (GetAttr(myPath & myFolder) And vbDirectory) = vbDirectory Then Workbooks.Open (myPath & myFolder & "\" & myBook) Range("C9").Activate Selection.Copy ThisWorkbook.Activate Cells(i, 1) = myFolder Cells(i, 2).PasteSpecial xlValues Cells(i, 3) = FileDateTime(myPath & myFolder & "\" & myBook) Workbooks(myBook).Close SaveChanges:=False i = i + 1 End If End If myFolder = Dir() Loop End Sub

  • Excel 2010 VBA:ファイル名を読み込む

    下は複数のcsvファイルを一つに合体するVBAです。これにシートの右端に読み取ったファイル名を追加するにはどうしたらよいでしょうか。 よろしくお願いします。 Sub macro1() Dim myPath As String Dim myFile As String Dim s As String myPath = ThisWorkbook.Path & "\" On Error Resume Next Kill myPath & "合体版.csv" On Error GoTo 0 myFile = Dir(myPath & "*.csv") If myFile = "" Then Exit Sub Open myPath & "合体版.csv" For Output As #1 Do Until myFile = "" Open myPath & myFile For Input As #2 Do Until EOF(2) Line Input #2, s Print #1, s Loop Close #2 myFile = Dir() Loop Close #1 End Sub

  • VBAでブック名の拡張子を除去してシートにコピー

    VBA初心者でコード作成で困っております。 下記の通りコードを組みましたが、シート名をブック名に変更して 保存したいのですが、このコードですと拡張子までついてしまいます。 拡張子を除去するためにはどうすればよいでしょうか？ アドバイス宜しくお願い致します。 Sub test() 'シート名の変更 Dim MyPath As String Dim MyFile As String Dim Wb As Workbook MyPath = "C:\TEST\" MyFile = Dir(MyPath & "*.xlsx") Do While MyFile <> "" Set Wb = Workbooks.Open(MyPath & MyFile) ActiveSheet.Name = ActiveWorkbook.Name Application.DisplayAlerts = False Wb.Save Application.DisplayAlerts = True Wb.Close (False) MyFile = Dir() Loop End Sub

  • 「エクセルファイルが開いていたら開かない」としたい

    「エクセルファイルが開いていたら開かない」としたいです。 VB2010です。 -------------------------------------------------------------- Imports Microsoft.Office.Interop '参照設定済み Module Module1 Sub ExcelOpen() Dim ExcApp As Excel.Application Dim book As Excel.Workbook Dim MyPath As String MyPath = "C:" ExcApp = CreateObject("Excel.Application") ExcApp.Visible = True book = ExcApp.Workbooks.Open(MyPath & "\test.xlsm") End Sub End Module -------------------------------------------------------------- で、ファイルを開くのですが、既にファイルが開いている場合は、２個開いてしまい、 最後に開いたファイルが読み取り専用になってしまいます。 IFで、開いているかどうかを取得して、 開いているのなら「既に開いています」として、ExitSubがしたいです。 ご協力よろしくお願いします。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する