エクセルVBAシート転記でエラー1004

前へ 次へ
このQ&Aのポイント
  • エクセルVBAでシート間の転記を行う際にエラー1004が発生します。週入力シートのD5セルから下に入力されている内容を転記シートの同じセル範囲へ転記したいです。現在、転記先の開始位置としてD5セルを決め打ちしていますが、変数を使用して列の変更に対応したいと考えています。以前はfor next文を使用して1行ずつ転記していましたが、データ量が多く時間がかかるため、時間短縮のためのコードを検討しています。
  • エクセルVBAのシート間転記において、実行時エラー1004アプリケーション定義またはオブジェクト定義のエラーが発生しています。週入力シートのD5セルから下に入力されている内容を転記シートの同じセル範囲へ転記したいです。転記先の開始位置としては現在D5セルを使用していますが、将来的に列の変更に対応できるように変数を使用したいと考えています。以前はfor next文を使用して1行ずつ転記していましたが、データ量が多く時間がかかるため、時間の短縮を目指しています。
  • エクセルVBAでシート間の転記を行う際に実行時エラー1004アプリケーション定義またはオブジェクト定義のエラーが発生しています。週入力シートのD5セルから下に入力されている内容を転記シートの同じセル範囲へ転記したいのですが、現在は転記先の開始位置としてD5セルを使用しています。将来的に列の変更に対応するために変数を使用したいと考えています。以前はfor next文を使用して1行ずつ転記していましたが、データの量が多く時間がかかるため、時間短縮のための改善策を検討しています。
回答を見る
  • ベストアンサー

エクセルVBA,シート間転記でエラー1004

皆様宜しくお願いします。 以下の記述で 「実行時エラー1004アプリケーション定義　またはオブジェクト定義のエラーです」が 出てきます。 やりたい作業としては「週入力」シートの Ｄ５セルから下に入力されている内容を 「転記」シートの同じセル範囲へ転記したいです。 現在、転記先開始位置としてＤ５セルを決め打ちしています。 Ｄ行は固定ですが　列は変更になる可能性があるので ゆくゆく変数で書きたいと思っています。 以前はfor next で1行ずつ転記していてたのですが データが多すぎて時間がかかるので　すこしでも時間短縮できればと 思いコードをあれこれ考えています。 どうかよろしくお願いします。 Sheets("週入力").Select Dim aa As Long 　　　　　'A行の最終取得 aa = Range("A" & Rows.Count).End(xlUp).Row Dim 人数 As Long　　　　 '変数「人数」を定義 人数 = aa - 4 Dim wsデータ As Worksheet Dim ws結果 As Worksheet Set wsデータ = ActiveWorkbook.Worksheets("週入力") Set ws結果 = ActiveWorkbook.Worksheets("転記") ws結果..Range(Cells(5, "D"), Cells(人数 + 5 - 1, "D")) =ws結果.Range(Cells(5, "D"), Cells(人数 + 5 - 1, "D")).Value

  • ennkai
  • お礼率54% (284/525)

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

  • ベストアンサー
  • eden3616
  • ベストアンサー率65% (267/405)
回答No.2

ご質問のコードをそのまま利用するのであれば、以下のように変更してください。 ws結果..Range(Cells(5, "D"), Cells(人数 + 5 - 1, "D")) =ws結果.Range(Cells(5, "D"), Cells(人数 + 5 - 1, "D")).Value 　　　　　　　↓ ws結果.Range(ws結果.Cells(5, "D"), ws結果.Cells(人数 + 5 - 1, "D")) = wsデータ.Range(wsデータ.Cells(5, "D"), wsデータ.Cells(人数 + 5 - 1, "D")).Value ※CellやRangeオブジェクトには対象のシート（wsデータ、ws結果）を明示するようにしてください。省略した場合はアクティブシートが指定されてしまうため、思わぬ動作をする場合があります。 変数「列」にご希望の列記号を指定した場合に5行目から人数分のデータを同じ範囲でws結果で指定したシートへ値のみ複写するサンプルを載せておきます。 Sub sample1() Dim wsデータ As Worksheet Dim ws結果 As Worksheet Dim aa As Long Dim 人数 As Long Dim 列 As String Set wsデータ = ActiveWorkbook.Worksheets("週入力") Set ws結果 = ActiveWorkbook.Worksheets("転記") 列 = "D" wsデータ.Activate aa = wsデータ.Range("A" & Rows.Count).End(xlUp).Row 人数 = aa - 4 ws結果.Cells(5, 列).Resize(人数, 1) = wsデータ.Cells(5, 列).Resize(人数, 1).Value End Sub ※Rangeでセル範囲を指定すると長くなりがちなので、Resizeで選択範囲を拡張しています。また、変数の宣言はプログラムの冒頭でまとめて記述したほうが良いでしょう。

ennkai
質問者

お礼

回答ありがとうございました。 的確な回答に加えてリサイズについても 勉強させていただき、大変助かりました。

その他の回答 (3)

回答No.4

えーと、まず・・・ 行と列の関係を整理しましょうね。 エクセルの世界では 　行（縦方向：1～1048576） 　列（横方向：A～XFD）　　　※いずれも2007以降 と呼ぶのが一般的です。 行の高さ、列の幅　と言いますよね。 ちゃんと理解しておくと、あとが楽ですよ。 さて本題。 せっかくＡ列の最終行を取得しているのだから、 コピー・貼り付けではダメなのですか？ 　　　　wsデータ.Range("D5:D" & aa).Copy ws結果.Range("D5") 　　　　Application.CutCopyMode = False です。 元が数式で、それの計算結果だけを貼り付けたいなら 　　　　wsデータ.Range("D5:D" & aa).Copy 　　　　ws結果.Range("D5").PasteSpecial Paste:=xlPasteValues 　　　　Application.CutCopyMode = False くらいでしょうか。 どちらにしても、For～Nextよりはきっと早いですよ。

ennkai
質問者

お礼

回答ありがとうございました。 何気なく行と列を使っていましたが 自分でコードを見返して　あんまりな書き方だと気づきました。 コピーペーストも今度から使ってみたいと思います。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

Ｉｎｐｕｔが１シート、Ｏｕｔｐｕｔが１つ別シートうを扱う場合は（それ以上の数のシートを対象にする場合はもちろん Sub test01() Set sh1 = Worksheets("週入力") Set sh2 = Workshhet("転記") ・・・ End Sub のようにｏｂｊｅｃｔを最初に短い記号で定義して、 Ｒａｎｇｅ（セル）を式の左辺、右辺に定義して使う場合や、１セルでも（Rangeですが）指し示す・参照する場合は、ＲａｎｇｅやＣｅｌｌｓの記述の前に（上記の場合）Sh1.やSh2.を被せてコードを記述することを心がけてください。その１部の手抜きが原因ではないかな。 どういう場合にこれを省けるのか、（本やＷＥＢの説明記事が詳しく書いたものが見つからないという意味で）事例はむつかしいようだが。 概略的には、２Ｓｈｅｅｔ以上を使うときは必要と覚えているが。 ＷｏｒｋＢｏｏｋｓでも起こることと思うが、別ブックなら、限定が必要だと気づく場合が多いし、頻度が少ないので質問に出ないのだろう。

ennkai
質問者

お礼

エクセル関係でのご回答、いつも拝見いたしております。 自分での今後につながる貴重な内容、ありがとうございました。

回答No.1

ws結果.Range(ws結果.Cells(5, "D"), ws結果.Cells(人数 + 5 - 1, "D")) =wsデータ.Range(wsデータ.Cells(5, "D"), wsデータ.Cells(人数 + 5 - 1, "D")).Value

ennkai
質問者

お礼

一番最初にお答えくださり　ありがとうございました。 今度からきちんと明示して書こうとおもいます。

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. Excel（エクセル）

関連するQ&A

  • エクセルで入力シートから別シートに転記・蓄積について

    エクセルＶＢＡで入力シートのA1:D5（５行）の範囲を別シート（DBシート）の転記・蓄積させる方法を教えてください。また、入力データがA1:A5（１行）のときもあれば、A1:D5（５行）の場合ですが・・・ Sub test01() Dim ws1 As Worksheet, ws2 As Worksheet Dim x As Long, y As Long Set ws1 = Sheets("入力") Set ws2 = Sheets("DB") x = ws2.Cells(Rows.Count, "A").End(xlUp).Row + 1 y = ws1.Cells(Rows.Count, "A").End(xlUp).Row ws1.Cells(1, "A").Resize(y, 4).Copy ws2.Cells(x, "A") End Sub の場合、数式等、入力値すべてが転記となってしまいます。 値だけ転記する方法はありませんか？ 宜しくお願いいたします。

  • ExcelのVBAについてです。シート1と2を作成

    ExcelのVBAについてです。シート1と2を作成し、シート1にバーコードまたはキーボードで入力します。シート1は入力専用かつ入力した分の早見表で、実際にはシート2に転記仕訳して、シート3以降に表を作成したいです。使い方はシート1に入力またはシート2をタップまたはクリックすると入力(画面)になります。以前の質問の回答を参考に必要最低限に改良しています。パッと見で構いません、何か不具合は見付からないでしょうか？ '///Sheet1/// Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim time7 As Range For Each time7 In Target If time7.Column = 1 Then time7.Offset(0, 4).Value = Format(Now, "Short Time") & vbCrLf & _ Format(Now, "yyyy/mm/dd hh:nn:ss AM/PM") End If Application.EnableEvents = False Application.EnableEvents = True Next time7 '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 ws2.Range("A3:H3").Value = ws1.Range("A3:H3 ").Value End Sub Private Sub Worksheet_Activate() ' ' 新規行挿入 ' ' Worksheets("Sheet2").Range("3:3").Insert Sheets("Sheet1").Range("H3").Select ActiveCell.FormulaR1C1 = "5" Sheets("Sheet1").Range("E3").Select Selection.ClearContents Dim str_Left As String 'セルE4に文字列、セルH4に数字を予め入れておくこと。 str_Left = Left(Cells(4, 5), Cells(4, 8)) MsgBox str_Left & vbCrLf & " " & "OKボタンを押してください!" Sheets("Sheet1").Range("A3").Select Dim se_r As String se_r = Application.InputBox("バーコードを入力してください") Select Case se_r Case "False" MsgBox "キャンセルされました" Case "" MsgBox "空欄が入力されました" Case Else Range("A3").Value = se_r End Select End Sub ' ///Sheet2/// Private Sub Worksheet_Activate() Dim Emp(1 To 300) As String Dim msg As String Dim i, i2, Cnt As Integer Dim N_In As Variant For i = 3 To 3 If IsEmpty(Cells(i, 1).Value) = False Then 'ここで空欄判定 Worksheets("Sheet1").Range("3:3").Insert '対象セルアドレスを改行処理 End If '(1)シートを変数にセット Dim ws1 As Worksheet Dim ws2 As Worksheet Dim st1, s, i3 As Long Dim Bst As Range Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") '(2)シートを指定してデータを転記 st1 = ws1.Cells(Rows.Count, "E").End(xlUp).Row 'A列の最終行を設定する s = 3 For i3 = 3 To st1 Set Bst = ws2.Columns("E").Find(What:=ws1.Cells(i3, "E"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) シート間のE列を比較 If Bst Is Nothing Then '比較して無い場合は、下記を実行 ws1.Cells(s, "A") = ws1.Cells(i3, "A") '追加する文字を転記する。（コード） s = s + 1 End If Next i3 Next i '(1)シートを変数にセット Dim ws1_ As Worksheet Set ws1_ = Worksheets("Sheet1") ws1_.Activate End Sub

  • エクセル ＶＢＡ

    ＶＢＡ内で、そのＶＢＡの実行を制御することは可能でしょうか？ 下のようなコードを作ったのですが、 Sub 承認書作成() Dim ws0 As Worksheet, ws1 As Worksheet, r1 As Range Dim i As Long Dim nyuryoku(), chikuseki() Set ws0 = Worksheets("承認書作成") Set ws1 = Worksheets("顧客データ") Set ws2 = Worksheets("業者コード") Set ws3 = Worksheets("承認通知書") Worksheets("顧客データ").Select Range("テーブル1[[#Headers],[ＮＯ．]]").Select Selection.End(xlToRight).Select Selection.End(xlDown).Select Selection.ListObject.ListRows.Add AlwaysInsert:=False Range("B7").Select nyuryoku = Array("b5", "d5", "f5", "h5", "j5", "l5", "n5", "p5", "b6", "d6", "f6", "h6", "j6", "l6", "n6", "p6", "b4", "d4") '転記したいセルの位置 chikuseki = Array("0", "1", "5", "6", "8", "9", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "53", "54") '転記先の列のオフセット値 　Set r1 = ws1.Range("f" & Rows.Count).End(xlUp).Offset(0) 'データ蓄積セル 　For i = 0 To UBound(nyuryoku) r1.Offset(0, chikuseki(i)).Value = ws0.Range(nyuryokui)).Value '入力 Next MsgBox "入力完了" Dim lRowNum As Long '転記先となる行番号を求める lRowNum = ws1.Cells(Rows.Count, "b").End(xlUp).Row '転記 ws3.Cells(6, "d").Value = ws1.Cells(lRowNum, "j").Value ws3.Cells(17, "g").Value = ws1.Cells(lRowNum, "c").Value ws3.Cells(22, "g").Value = ws1.Cells(lRowNum, "l").Value ws3.Cells(22, "ac").Value = ws1.Cells(lRowNum, "ab").Value 　　 Set ws0 = Nothing 　 Set ws1 = Nothing End Sub ここに、 　 　　If call Macro1 then call 承認書作成 　'上のマクロです 　　 Else: Msgbox"中止" 「Macro1を実行しないと承認書作成マクロを実行できない」 という コードを組み込みたいのですが、うまくいきません。 ＶＢＡ内に同じＶＢＡを組み込むことは不可能なのでしょうか？

  • エクセルVBAの転記について

    エクセル2013VBAで最終行を取得しての転記が上手くいきません。どのようにすれば良いかご教授ください。 簡単なサンプルを下記します。 Sub サンプル入力からのDBへの転記() Dim Sh1 As Worksheet Dim Sh2 As Worksheet Dim myRow As Long Set Sh1 = Worksheets("サンプル入力") Set Sh2 = Worksheets("サンプルDB") With Sh2 myRow = Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & myRow).Value = Sh1.Range("D4").Value .Range("B" & myRow).Value = Sh1.Range("F4").Value End With End Sub 入力内容を変えないテストでは (1)実行するとDBへの転記は問題なく出来ます。 (2)継続してマクロを実行しても問題なく転記が行われ、同じデータが蓄積されていきます。 入力内容を変更して引き続きマクロを実行すると挙動不審に陥ります。 現象としては (1)初めの行に何度も重ねて転記を行う。 (2)空白行を作り、その行に何度も転記を行ってしまう。 (3)空白行を作り、それ以降転記を実行し蓄積を行ってしまう。 入力シートには結合セル、リストを使用していますが、原因究明を行う中でこれが原因とは思えませんでした。 これがクリアできないと先に進めません。ぜひお力を貸してください。 宜しくお願い申し上げます。

  • VBA マクロ　シート　転記

    はじめまして。VBA初心者です。今シート１のA列1行目セルにA社、A列2行目にB社、A列3行目にC社と・・ざっと1000行程あり、それぞれB列には値があります。この値をシート２のＢ列に転記したいと思っています。ただ、毎月シートを追加していきますので、左隣のシートから転記しなければなりません。シート２の項目は同じA列とB列で構成されています。A列の値が多少前後するので、FINDを使って以下のようなプログラムを作りました。ただ、左隣のシートから転記とう内容をどうやって追加したら良いのかがわかりません。Previous　をどこかに使えばできるのかなとも思うのですが、その方法がわかりません。 Sub 転記() Dim ws As Worksheet, ws1 As Worksheet, r As Range, r1 As Range Dim LastRow As Long, i As Long, er As Long, wkey As String Set ws = Worksheets("Sheet1") Set ws1 = Worksheets("Sheet2") LastRow = ws.Range("A1").End(xlDown).Row er = ws1.Range("A1").End(xlDown).Row Set r = ws.Range("A1:A" & LastRow) For i = 1 To er wkey = ws1.Range("A" & i) Set r1 = r.Find(What:=wkey, LookIn:=xlValues, LookAt:=xlWhole) If Not r1 Is Nothing Then ws1.Range("B" & i) = r1.Offset(, 1) End If Next Set r1 = Nothing Set r = Nothing Set ws = Nothing Set ws1 = Nothing End Sub どなたか詳しいお方いらっしゃいましたら、初心者の私に教えて頂けませんでしょうか？宜しくお願いします。

  • EXCEL2010エラーVBA

    下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391　がエラーメッセージです。 何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub

  • VBA転記について教えて下さい

    200件位のデータがあるとします。顧客情報AB・商品C～AY 氏名　性　　青森りんご　長野りんご　みかん　バナナ　送料 AA　 男　　　1　　　　　　　　　　　　 2　　　　　　100 BB　 女　　　　　　　　　　1　　　　　　　　　　　　100 CC　 男　　　　　　　　　　　　　　　　　　 3　　　　 0 このデータを別シートAにはりんごと送料　別シートBにはそれ以外のデータに分けたいのです。 シートA 氏名　性　　青森りんご　長野りんご　　送料 AA　　男　　　1　　　　　　　　　　　100 BB　　女　　　　　　　　1　　　　100 CC　　男 シートB 氏名　性　　みかん　バナナ AA　　男　　　 2 BB　　女 CC　　男　　　　　　 3 こんな感じです。 色々参考にして作成しましたがうまくいきませんでしたので 教えて欲しいです。 よろしくお願いします。 エクセルは2002です。 １、項目名の転記でデータは200位ですが変動があるので最終行で作成したら うまくいきませんでした。 ２、データ域の転記が動きません。 Sub サンプル() Dim i As Long Dim lastRow As Long Dim lastcolumns As Long Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet Dim myColumns As Long Dim myKey As String Set S1 = Worksheets("データ") Set S2 = Worksheets("りんご") Set S3 = Worksheets("その他") ' Sheet1の最終行を取得 lastRow = S1.Range("A" & Rows.Count).End(xlUp).Row ' Sheet1の最終列を取得 lastcolumns = S1.Cells(1, Columns.Count).End(xlToLeft).Column ' 項目名の転記 S2.Range("A1:B200").Value = _ S1.Range("A1:B200").Value S3.Range("A1:B200").Value = _ S1.Range("A1:B200").Value 'データ域の転記 For i = 2 To lastcolumns myKey = S1.Cells(1 & i).Value If myKey <> "" Then myColumns = Worksheets(myKey).Cells(1, Columns.Count).End(xlUp).Columns + 1 S1.Range(S1.Cells(1, i), S1.Cells(lastRow, i)).Copy _ Worksheets(myKey).Range(Cells(1, myColumns), Cells(lastRow, myColumns)) End If Next i End Sub

  • エクセルのＶＢＡの記述について

    ＶＢＡの記述についてなのですが、 Sub filter() Dim gyo As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Set ws1 = Worksheets("データ") Set ws2 = Worksheets("チーム") Application.ScreenUpdating = False ws2.Range("A4:BH30").Clear gyo = ws1.Range("A65536").End(xlUp).Row ws1.Activate With ws1.Range(Cells(4, 1), Cells(gyo, 6)) .AutoFilter Field:=1, Criteria1:="A" .SpecialCells(xlCellTypeVisible).Copy ws2.Range("A4") Selection.AutoFilter End With Application.ScreenUpdating = True End Sub ならプログラムははしるのですが、 １４行目を .SpecialCells(xlCellTypeVisible).Copy ws2.Range(Cells(4, 1)) だと 「実行時エラー １００４ Rangeメソッドは失敗しました　Worksheet　オブジェクト」 とでるのですが、出来ないのでしょうか？ Cells(4, 1)の１のところを変数にして変えていきたいのですが、よい方法はありますか。 よろしくお願いいたします。

  • エクセル ＶＢＡ データ入力

    こんにちは、はじめまして。 エクセル・ＶＢＡ初心者です。 会社に入って３ヶ月になります。 同じファイル内で、入力用シートから 違うシートに表としてデータを転送するため、 本や今まで作ったものを参考にして下のようなVBAを作成したのですがうまくいきません。 Sub 転記() Dim ws0 As Worksheet, ws1 As Worksheet, chikuseki As Range Dim nyuryoku() Set ws0 = Worksheets("Worksheet1") Set ws1 = Worksheets("Worksheet2") nyuryoku = Array("b3", "d3", "f3", "h3") '転記したいセルの位置 Set chikuseki = ws1.Range("f", "g", "k", "q" & Rows.Count).End(xlUp).Offset(1) 'データ蓄積セル For i = 0 To UBound(nyuryoku) chikuseki.Offset(0, i).Value = ws0.Range(nyuryoku(i)).Value ws0.Range(nyuryoku(i)).MergeArea.ClearContents Next masgbox "入力完了" End Sub 十何個あるデータを転送する場合、フォームから入力した方が簡単なのでしょうか？ また、表にデータを転記し、そのなかのデータのいくつかを別の表に転記することは、一度の操作で可能ですか？ 今週中に仕上げろと言われたので急いでいます、 どうかよろしくお願いします。 質問がまとまっていなくてわかりにくければ申し訳ないです。

  • VBAエクセルにて開いてないエクセルシートを開いてるシートに所得

    お世話になります。 「同じフォルダー内にBOOKが2つ有ります。1つ（AK.xls）を立上げて もう1つの（EX.xls）を立上げずに、EX.xls内のSheet1をコピーして AK.xlsのシート（STEP1）に貼り付けようとしています。」 どうしてもエラーが出てしまいます。 何方か、分かる方教えて下さい。 また記述して戴ければもっと助かります。 エラーは”1004”EX.xlsが見つかりません。と出てしまいます。 Sub ST() Dim wsSrc As Worksheet, WS As Worksheet Dim PasteR As Range Dim x As Long Sheets("STEP1").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select 　　Set wsSrc = ActiveSheet Workbooks.Open "EX.xls" For Each WS In Worksheets x = WS.Range("A1").CurrentRegion.Rows.Count If WS.Index = 1 Then Set PasteR = wsSrc.Range("A1") Else Set PasteR = wsSrc.Range("A65536").End(xlUp).Offset(1) End If WS.Range(WS.Cells(1, 1), WS.Cells(x, 44)).Copy PasteR Set PasteR = Nothing Next ActiveWorkbook.Close False Set wsSrc = Nothing End Sub デバックでは Workbooks.Open "EX.xls"この部分が黄色になります。 是非、回答を宜しくお願い致します。

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する