VBA VLOOKUPとセルのコピーができません

このQ&Aのポイント
  • VBA VLOOKUPを使用してセルのコピーを行いたいが、うまくいかない
  • Sheet3の4列目の数値をSheet1のG列で照合し、Sheet1の9列目に持ってくることをしたい
  • コピーを実行すると「アプリケーション定義またはオブジェクト定義のエラーです。」というエラーが発生する
回答を見る
  • ベストアンサー

VBA VLOOKUPとセルのコピーができません

助けてください マクロでVLOOKUPを使い、データを持ってこようとしてますが上手くいきません やりたいこと:Sheet3(在庫を貼付)にある4列目の数値を、Sheet1のG列で照合し、Sheet1の9列目に持ってきたい Sheet1:cells(6,9)にVLOOKUPの式を入れる 関数で言えば=VLOOKUP($G,Sheet3!C:F,4,FALSE) cells(6,9)をcells(7,9)からcells(2000,9)までコピー これを実行すると 「アプリケーション定義またはオブジェクト定義のエラーです。」 とでて止まってしまいます ActivesheetsやWorkbooks、WorksheetsやSheetsで設定したりしてもエラーは変わりますが 止まってることには変わりありません どうしたら動くようになりますか? Sub vlook() Dim Nname As String macx = "ルーチンワーク20130223.xlsm" 'マクロ用ファイル「ルーチンワーク20130223.xlsm」がある Sheets(1).Select Workbooks(macx).Activate Worksheets(1).Activate ddir = Cells(33, 2) 'cells(33,2)にフォルダ情報がある Nname = Dir(ddir & "在庫推移.xlsx") '在庫推移.xlsxというVLOOKUPしたいファイルがある Workbooks.Open Filename:=ddir & Nname Workbooks(Nname).Activate Sheets(1).Select Worksheets(1).Activate 'VLOOKUPで在庫を持ってくる ActiveCell.FormulaR1C1 = "=VLOOKUP(RC7,'在庫を貼付'!C[-6]:C[-3],4,FALSE)"   '自動記録マクロから持ってきてます Worksheets(1).Activate Sheets(1).Select Range(Cells(6, 9)).Copy Destination:=Sheets(1).Range(Cells(7, 9)) 'この行でエラーが出る

  • t2grp
  • お礼率72% (50/69)

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

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

エラー行に2個あるRange()が不要です。 Range(Cells(6, 9)).Copy Destination:=Sheets(1).Range(Cells(7, 9)) →Cells(6, 9).Copy Destination:=Sheets(1).Cells(7, 9) Range(Cells(6, 9))だと、Cells(6, 9).Valueが表すアドレスを参照してしまう。 たとえば Cells(6, 9) に "B1" と書かれていたら、Range(Cells(6, 9)) は Range("B1") のことになる。 で、Cells(6, 9) が空欄なら Range("") みたいなことになって参照できないのでエラー。

t2grp
質問者

お礼

すみません 自己解決しました R1C1形式でも絶対列の設定ができました ActiveCell.FormulaR1C1 = "=VLOOKUP(RC7,'在庫を貼付'!C3:C6,4,FALSE)" c[-6]:c[-3]→c3:c6と変更 F4を押して選ぶのは、関数の時と一緒ですね (関数で言うとC列→$C列) これで参照先が継承されました 昨日からずっと悩んでたのが解決して嬉しいです ありがとうございました

t2grp
質問者

補足

即レスありがとうございます! ご指摘のようにRange()を外すとエラーが起きなくなりました ただしVLOOKUPの式の入ったセルが、cells(1,1)にあってこれをcells(6,9)にコピーすると#REF!エラーとなり、参照先の列が消えてしまって上手く動いてません R1C1形式でないVLOOKUPの設定はどうやるか教えて頂けますか? ※条件を書くのを忘れてました OS:Windows7 Home Premium(64bit) Ver:Excel2013(32bit)

その他の回答 (1)

  • mt2008
  • ベストアンサー率52% (885/1701)
回答No.2

Range(Cells(6, 9)) この書き方が良くないです。 Range(Cells(6, 9)).Copy Destination:=Sheets(1).Range(Cells(7, 9)) 'この行でエラーが出る ↓ Cells(6, 9).Copy Destination:=Worksheets(1).Cells(7, 9) と、書き換えてみて下さい。 2000行までコピーしたいなら Cells(6, 9).Copy Destination:=Worksheets(1).Range(Cells(7, 9), Cells(2000, 9)) です。

t2grp
質問者

お礼

すみません 自己解決しました R1C1形式でも絶対列が指定できることが分かりました (詳細はNo.1さんのお礼欄に記載してます) これで式を2000行までコピーして使えます ありがとうございまいた

t2grp
質問者

補足

すばやいレスありがとうございます ご指摘通り修正したら、コピーに関しては無事動くようになりました(2000行まで実行してます) ただNo.1の方にも質問しましたが、VLOOKUPの式がcells(1,1)にあり、コピーでcells(7,9)からcells(2000,9)に持ってくると参照元のセル情報が消えているため#REF!エラーとなります (関数で言えば=VLOOKUP($G7,'在庫を貼付'!#REF!,4,FALSE)のようになります) VLOOKUPの式をcells(6,9)に設定するか、R1C1形式で設定できるのか教えてもらえますか? ※条件を書くのを忘れてました OS:Windows7 Home Premium(64bit) Ver:Excel2013(32bit)

関連するQ&A

  • 別のブックへ貯蓄転記する方法を教えてください。

    請求書をエクセルで作ることになりました。 請求書自体はできたのですが、 請求書内容を別のブックに貯蓄保存がどうしてもできません。 ブック「A」のM1~R1のみが転記対象。VLOOKUPを使ってデータをひいています。 ブック「B」のA3~F3に貯蓄&転記したいと考えています。 色々なサイトを見て、下記のコードを作ったのですが、貯蓄できません・・・ (上書保存のような状態になります) 初心者のため、何が間違っているのかわかりません。 ご教授いただければと思います。 よろしくお願いいたします。 Sub SAVE() Const Dest = "C:\Users\P\Desktop\Y\B.xlsx" Dim fromR As Long Dim fromRMax As Long Dim toR As Long Dim toRMax As Long '?????? toRMax = Workbooks("B.xlsx").Worksheets("Sheet1").Range("A65536").End(xlUp).Row fromRMax = Workbooks("A.xlsm").Worksheets("Sample").Range("A65536").End(xlUp).Row '?? For fromR = 2 To fromRMax 'Date Workbooks("B.xlsx").Worksheets("Sheet1").Cells(toRMax + fromR - 1, 1).Value = _ Workbooks("A.xlsm").Worksheets("Sample").Cells(fromR, 13).Value 'No. Workbooks("B.xlsx").Worksheets("Sheet1").Cells(toRMax + fromR - 1, 2).Value = _ Workbooks("A.xlsm").Worksheets("Sample").Cells(fromR, 14).Value 'Sub Workbooks("B.xlsx").Worksheets("Sheet1").Cells(toRMax + fromR - 1, 3).Value = _ Workbooks("A.xlsm").Worksheets("Sample").Cells(fromR, 15).Value '13% Workbooks("B.xlsx").Worksheets("Sheet1").Cells(toRMax + fromR - 1, 4).Value = _ Workbooks("A.xlsm").Worksheets("Sample").Cells(fromR, 16).Value '5% Workbooks("B.xlsx").Worksheets("Sheet1").Cells(toRMax + fromR - 1, 5).Value = _ Workbooks("A.xlsm").Worksheets("Sample").Cells(fromR, 17).Value 'Total Workbooks("B.xlsx").Worksheets("Sheet1").Cells(toRMax + fromR - 1, 6).Value = _ Workbooks("A.xlsm").Worksheets("Sample").Cells(fromR, 18).Value Next fromR End Sub

  • エクセルVBAで他のbookのセルcellsで参照

    エクセルVBAで他のbookのセルの値(一定の範囲)を参照したいのですが、変数を使いたいため、cellsを使用したいのですがうまくいきません。方法はないでしょうか。 下記に例を示します。 rangeを使用すればすべてok((2)(5))(この場合はset文を使用しなくてもok(5))。同じbookならcells使用ok(4)。 他のbookをcells文使用する方法はないでしょうか(もちろんできれば、Thisbookの方もcellsを使用したい)。 よろしくお願いします。 sub test() Dim ThisBook As Workbook Dim Workbook2 As Workbook 'マクロを実行しているワークブック Set ThisBook = ThisWorkbook '他のワークブック Set Workbook2 = Workbooks("test11.xlsx") ' 'ThisBook.Worksheets(1).Range("A1:B2").Value = Workbook2.Worksheets(1).Range(Cells(1, 1), Cells(2, 2)).Value  '(1)だめ 'ThisBook.Worksheets(1).Range("A1:B2").Value = Workbook2.Worksheets(1).Range("a1:b2").Value '(2) OK 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:B2").Value = Workbooks("test11.xlsx").Worksheets(1).Range(Cells(1, 1), Cells(2, 2)).Value '(3) だめ 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:B2").Value = Workbooks("test1.xlsm").Worksheets(1).Range(Cells(3, 3), Cells(4, 4)).Value  '(4)だめ 'Workbooks("test1.xlsm").Worksheets(1).Range("A1:ii8000").Value = Workbooks("test11.xlsx").Worksheets(1).Range("a1:ii8000").Value  '(5) ok End Sub

  • エクセル2007VBAで新規ファイルを作る場合

    現在A社というファイルのsheet1に電気代と名前を付けたデータ、sheet2に ガス代という名前を付けたデータがあり電気代のブックからコピーして新規ファイルに貼り付けをしたいと思い下記のとおりマクロがありますが、新規ブックを開いた時常に1ではなく他に新規ブックを開いていたら2とか3になってしまいます。すると再度新規ブックに戻ってガス代を貼り付ける時2とか3tpか4とかでしたらエラーになってしまいます。 こういう場合どのように書いたら良いのでしょうか? それから最後に新規ファイルで名前を付けて保存のところまでダイアログ出すところまで 教えていただきたいのですが。 マクロ勉強始めたばかりでよろしくお願います。 Sub DGCopy() Cells.Select Selection.Copy Workbooks.Add Cells.Select ActiveSheet.Paste Sheets("Sheet1").Select Sheets("Sheet1").Name = "電気代" Windows("A社.xls").Activate Sheets("電気代").Select Cells.Select Application.CutCopyMode = False Selection.Copy Windows("Book1").Activate Sheets("Sheet2").Select Cells.Select ActiveSheet.Paste Sheets("Sheet2").Select Sheets("Sheet2").Name = "ガス代" Application.CutCopyMode = False End Sub

  • エクセルマクロで不特定なファイル名を使用するには

    初めて質問します。 不適切があれば申し訳ございません。 教えていただきたいです。 ファイル名が日々変わる場合、以下のマクロを使用した際に ファイル名が変ったとしてもマクロが実行できるようにするにはどうすれば良いでしょうか? ファイル名が変るのが"日別進捗_20140814.xlsx"の日付の所です。 初歩的で誠に申し訳ございません。 教えていただければ幸いです。 ----------------------------------------------------------- Sub Macro1() ' ' Macro1 Macro ' ' Sheets("Sheet2").Select Windows("日別進捗_20140814.xlsx").Activate Cells.Select Selection.Copy Windows("Book1.xlsm").Activate Cells.Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Range("A1").Select Sheets("Sheet1").Select Range("D15").Select End Sub

  • VBAについてです。

    VBAについてです。 当方VBA初心者です。初歩的な質問があり投稿しました。 Workbooks("aaaa.xlsx").Worksheets("aaa").Range("A3:A50").Copy _ Workbooks("bbbb.xlsx").Worksheets("bbb").Range("A2") というコピーはできるのに Workbooks("aaaa.xlsx").Worksheets("aaa").Range(cells(3, 1), cells(50, 1)).Copy _ Workbooks("bbbb.xlsx").Worksheets("bbb").Range("A2") というコピーはどうしてできないのでしょうか? また、最下行を判別して Workbooks("aaaa.xlsx").Worksheets("aaa").Range(cells(3, 1), cells(最下行, 1)).Copy _ Workbooks("bbbb.xlsx").Worksheets("bbb").Range("A2") という様に簡単に処理したいのですが、やはり無理なのでしょうか? ブックが違うのですが、これをなんとかこのような処理にしたいと思っています。

  • エクセルVBAでエラー、Changeの使い方が×?

    エクセルVBAでBOOK1のsheet1とsheet2とsheet3があり、 sheet1とsheet2の全ての情報をsheet3にコピーしてまとめるようにしました。 マクロを実行するには、Visual Basicを開いてF5を押しています。 それをsheet1かsheet2の中身の一部分でも変更すると そのときに自動的にマクロが実行されるようにしたいです。 sheet1とsheet2とsheet3に Private Sub Worksheet_Change(ByVal Target As Range) Call マクロ() End Sub を入れ、 標準モジュールに Sub マクロ() Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150") Dim UsedCell As Range Dim Max_Row, RowCount As Integer Set UsedCell = ActiveSheet.UsedRange Max_Row = UsedCell.Cells(UsedCell.Count).Row Application.ScreenUpdating = False For RowCount = Max_Row To 1 Step -1 If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then Rows(RowCount).Delete End If Next Application.ScreenUpdating = True End Sub をやって、sheet1かsheet2のセルを変更すると エクセルが固まってしまいます。 デバックでは最初の Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _ Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50") がよくないようです。 書き方が間違っているのでしょうか?

  • vbaで別のシートにセルで選択した列を反映させたい

    初めて質問させて頂きます。 vbaで別のシートにセルで選択した項目を反映させたいのですが出来ず困っております。 どなたかご教授頂けますでしょうか。 SR.xlsm ・B4からB100まで4桁の店舗コードがあります。 ・C4からC100までは住所。 ・D4からD100までは電話番号。 master.xlsx ・A1に店舗コードを貼り付けたい ・B2に住所を貼り付けたい ・D3に電話番号を貼り付けたい 作業内容としては以下をしたいのです。 例えばSR.xlsmのB50を選択してボタンをクリックすると master.xlsxが自動的に立ち上がり、 master.xlsxのA1 ⇒ B50を貼り付け master.xlsxのB2 ⇒ C50を貼り付け master.xlsxのD3 ⇒ D50を貼り付け 以下、自分なりにやってみたのですがどのセルを選択してボタンを押してもB4の列しか反映されません。 大変お手数をおかけいたしますがご教授願いますでしょうか。 宜しくお願い致します。 Sub click() ' ' click Macro ' ' Range("B4").Select Selection.Copy Workbooks.Open Filename:= _ "\\0000000\22\33\44\master.xlsx" ActiveSheet.Paste Windows("SR.xlsm").Activate Range("C4").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsx").Activate Range("E2").Select ActiveSheet.Paste Windows("SR.xlsm").Activate Range("D4").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsx").Activate Range("E4:H4").Select ActiveSheet.Paste Windows("SR.xlsm").Activate Range("E4").Select Application.CutCopyMode = False Selection.Copy Windows("master.xlsx").Activate Range("H2:H3").Select ActiveSheet.Paste End Sub

  • 「複数の選択範囲に対して実行できません」エラー

    Excel2007でVBAのプログラムを作成していますが、以下の処理を行うと、いずれも 「そのコマンドは複数の選択範囲に対して実行できません」エラーになります。 エラーになるのは、VBAマクロがあるファイルAだけなので、これに問題があるのだろうと思いますが、特に特殊なことをしているわけではなく、フォームやボタンを作成し、その処理プログラムが書かれているだけのものです。 シートは常に1シートのみを表示し、アクティブでないシートは非表示になるようにしていますが、 全てを表示しても同様のエラーになります。 シートは保護してあっても、解除されていても同様のエラーになります。 Excelファイルによってこのような事象が起きることはあるのでしょうか? <エラーになる処理> (1)ファイルA.xlsmのシート上で1セルをコピーし、別ファイルのシートに張り付けるとき。 (2)上記をプログラムから行う。 With Workbooks(pMyAplName).Sheets("AAA") .Activate .Range(.Cells(1, 1), .Cells(100, 20)).Copy Workbooks(pNewFileName).Sheets(strStName).Activate Workbooks(pNewFileName).Sheets(strStName).Cells(1, 1).Select ActiveSheet.Paste End With (3)ファイルA.xlsmに新規シートを追加する(手動だと新規シートをクリック)とき。 (4)上記をプログラムから行う。 With Workbooks(pMyAplName) .Worksheets.Add After:=Sheets(Sheets.Count) .ActiveSheet.Name = "WKAAA" End With 但し、(1)はExcelアプリケーションをもう1つ起動させ、そこで開いたファイルにならコピペできます。 (ファイルAと同じExcelアプリケーション上で開かれたファイルだとエラーになる)

  • EXCEL VBA セルからファイル名を読み込む

    EXCEL VBAについての質問です 同じ処理を名前の違う複数のファイルで行いたいと思っています そこで、セルA2へファイル名の『○○.xls』○○部分だけをそれぞれのファイルに書き込んでおき、マクロは共通にしてファイル名をそれぞれのファイルから読み込んで実行したいと思っています。 良い方法を教えてください。 Workbooks("200809.csv").Activate Sheets("200809").Select Range("C3:C33").Copy Windows("○○.xls").Activate'←ここをファイルにあわせて変更できる形にしたい Sheets("報告書").Select Range("G5:G35").Select ActiveSheet.Paste Windows("200809.csv").Activate Range("K3:K33").Copy Windows("○○.xls").Activate’←ここ Sheets("報告書").Select Range("I5:I35").Select ActiveSheet.Paste Workbooks("200809.csv").Close SaveChanges:=False よろしくお願いします。

  • エクセルVBAで別ブックの条件検索

    VBA初心者です。エクセルは2007です。 『データのあるブック(Book1,Book2,Book3)』と、『検索条件シート+出力先シートをもつブック』の4つのブックがあります。 検索条件シートで、L22でブック、P22でシートを指定してN22に入力した数に対応するデータをVlookupで出力先シートのセルに抽出されるようにしたいのですが、※の部分で「エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません」とでて実行できません。 データのあるブックは同じ形式でシートには表があります。 数 a b c d 1 A B C D 2 ○ × △ ■ 3 Z Y X W     ・     ・ 検索条件がL22=3,P22=2,N22=2だとすると、Book3の2枚目のシートを検索し、 出力先シートのD1=○,J6=×,L23=△,J69=■となるようにしたいです。 本やインターネットで調べましたがわかりませんでした。 解決方法を教えていただきたいです。お願いします。 Sub 検索() Dim a, b, c, d As Range Dim 番号, ブック, シート As Integer With Workbooks("検索.xlsm").Sheets("検索条件") 数 = .Range("N22").Value ブック = .Range("L22").Value シート = .Range("P22").Value End With Dim wb As Workbook Dim sh As Worksheet Dim set範囲 As Variant With Workbooks("検索条件.xlsm").Sheets("出力先") Set a = .Range("D1") Set b = .Range("J6") Set c = .Range("L23") Set d = .Range("J69") End With Select Case ブック Case 1 Set wb = Workbooks("Book1.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case 2 Set wb = Workbooks("Book2.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case 3 Set wb = Workbooks("Book3.xlsm") wb.Activate Select Case シート Case 1 Set sh = Worksheets(1) Case 2 Set sh = Worksheets(2) Case Else MsgBox "・・・・・", vbExclamation, "nothing" End Select Case Else MsgBox "nothing", vbExclamation, "nothing" End Select ※Set set範囲 = wb.sh.Range("A4:E42")  ←エラー438 a = Application.WorksheetFunction.VLookup(数, set範囲, 2, False) b = Application.WorksheetFunction.VLookup(数, set範囲, 3, False) c = Application.WorksheetFunction.VLookup(数, set範囲, 4, False) d = Application.WorksheetFunction.VLookup(数, set範囲, 5, False) End Sub

専門家に質問してみよう