• ベストアンサー

エクセルVBA データの転記に関して質問です

在庫管理の為に以下の通りに作成をしています。 (1)シート1からシート2へデータを転記したい。 (2)シート1からシート2へデータを転記した時シート2にはデータが蓄積されていきます (3)シート1のコピー範囲には空白のセルが含まれています。 (4)シート1の空欄の一部は数式による空白があります。 シート1 C8入庫年月日 C9伝票番号 C10品名 C11品番 C12単位 C13数量 C14単価 C15金額 C16入荷先 C17備考 シート2 C4入庫年月日 C5伝票番号 C6品名 C7品番 C8単位 C9入庫数量 C10単価 C11金額 C12入荷先 *C17は転記しません。 以下のとおりに記述しました。 Dim ab As Long Dim cd As Long Range("C9:k18").Copy Sheets("1").Select Cells(Rows.Count, 3).End(xlUp).Offset(1).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=True, Transpose:=False ab = Range("H" & Rows.Count).End(xlUp).Row For cd = ab To ab + 10 Step 1 If ActiveSheet.Cells(cd, 8) = "" Then Rows(cd).Delete shift:=xlUp End If Next cd Sheets("2").Select Application.CutCopyMode = False Range("e6").Select End Sub この記述で実行すると、1度目の転記はうまくいくのですが2回目の転記をしたときに空白行が入り、空白行の下に2回目の転記が行われてしまいます。 どうしたら空白行を無視して2回目の転記がうまくいくでしょうか? VBA初心者です。よろしくお願いします。

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

  • ベストアンサー
  • hige_082
  • ベストアンサー率50% (379/747)
回答No.1

回答が付かないようなので まずは、 質問間違ってませんか? >シート1 C8入庫年月日 C8伝票番号 C10品名 ・・・ C17備考 >シート2 C4入庫年月日 C5伝票番号 C6品名 ・・・ C12入荷先 >*C17は転記しません。 シート1 C8入庫年月日 D8伝票番号 E8品名 ・・・ L8備考 シート2 C4入庫年月日 D4伝票番号 E4品名 ・・・ K4入荷先 *L8は転記しません。 では、ありませんか こうしないと質問にあるコードと矛盾しませんか? >この記述で実行すると、1度目の転記はうまくいくのですが2回目の・・・ うまく行きませんよね? シート1のデータがシート1に貼り付けられるようになってますよ 整理します シート1の9行目以降のデータをシート2の5行目以降にコピーする コピーの条件として入庫年月日と数量が入力されているもののみ シート2にはデータを蓄積するため、最終行以降に順次追加していく この条件を満たしたものが下のコードです Sub test() Dim i As Long With Worksheets("1") For i = 9 To .Cells(Rows.Count, 3).End(xlUp).Row If .Cells(i, 3).Value <> "" And .Cells(i, 8).Value <> "" Then .Cells(i, 3).Resize(, 9).Copy Worksheets("2").Cells(Rows.Count, 3).End(xlUp).Offset(1).PasteSpecial Paste:=xlValues Application.CutCopyMode = False End If Next i End With Worksheets("2").Select Range("e6").Select End Sub これでうまく行かないのであれば もう一度質問を整理して 再度質問することをお薦めします 以上参考まで

manachan1
質問者

お礼

ありがとうございました。 #1さんに書いて頂いたコードでちゃんと動作するようになりました。勉強不足と、質問がうまく整理されておらず申し訳ありませんでした。

その他の回答 (1)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 最初に、質問は正確にお願いします。#1さんの解釈と、私の解釈が違うということは、それだけコードが曖昧なのかもしれません。 ご質問の回答のポイントとしては、行を削除するときは、下から上に Step -1 とすることです。うまく行かないというのは、以下の部分で、コピー後ですから、 >ab = Range("H" & Rows.Count).End(xlUp).Row >For cd = ab To ab + 10 Step 1 これでは、一番下の行 ab から先に、10行下には、何もあるわけないので、 For cd = ab To ab - 10 Step - 1 こういうことではないかとは思います。 後は、#1さんとも重複しますが、 >シート1 C8入庫年月日 C9伝票番号 C10品名 C11品番 C12単位 C13数量 C14単価 C15金額 C16入荷先 C17備考 >シート2 C4入庫年月日 C5伝票番号 C6品名 C7品番 C8単位 C9入庫数量 C10単価 C11金額 C12入荷先 Range("C9:k18").Copy としていますが、コピーの対象は、C8 ~列方向となっています。これは、縦ではなく、横に並ぶのではないでしょうか? >(1)シート1からシート2へデータを転記 ということで、なぜ、Range("C9:K18").Copy 後に、Sheets("1").Select が出てくるか分かりません。 >Range("C9:K18").Copy  ←そもそも、これが良く分からないです。 固定したデータ行なのでしょうか?このデータは、Sheets("1")にあるものでしょうか?

manachan1
質問者

お礼

回答ありがとうございました。勉強不足で質問が分かりづらくすみませんでした。 #1さんに教えて頂いたコードでうまく動作するようになりました。 これからもっと頑張って勉強します。

関連するQ&A

  • EXCEL VBA 転記 条件分岐 新規転記 上書転記 プログラム

    いつも御世話になっております。 以下のことをしたいのですが、詰まってしまいました。 皆様の力をお借りしたいと思い、書き込ませていただきます。 ・ボタン1をクリックすると、base(転記元)のG列に書かれた事項と同一のシート(転記先)へ転記する(各シートA,B,Cへ転記) ・転記先のE列を見て、既存のものであれば、上書きする ・転記先のE列を見て、新規のものであれば、空いている行を探し転記する。 (例) base(転記元シート) E1|F1|G1 名前 収入 シート先 月曜 50 A 火曜 100 A 木曜 150 C 土曜 50 A 日曜 100 B 水曜 150 A 金曜 10 C 転記実行前 A(転記先シート) E1|F1|G1 名前 収入 シート先 月曜 A 火曜 A 土曜 A 転記実行後 A(転記先シート) E1|F1|G1 名前 収入 シート先 月曜 50 A 火曜 100 A 土曜 50 A 水曜 150 A 以下に作成したプログラムを記述します。 が、IF文に関するエラーが生じております。 Sub ボタン1_Click() Dim dstSheet As Worksheet Dim srcRow As Long Dim dstRow As Long Dim name As Integer Dim obj As Object Set srcSheet = Sheets("base") For srcRow = 2 To srcSheet.Range("G" & Rows.Count).End(xlUp).Row '元シートのデータ範囲で繰り返し(シート先は必須なのでG列でチェック) If srcSheet.Range("G" & srcRow).Value <> "" Then '(転記先シート名)が空白でない場合に実行(1) Set dstSheet = Sheets(srcSheet.Range("G" & srcRow).Value) 'シート取得(1) name = Sheets(srcSheet.Range("E" & srcRow).Value) '名前を取得(1) Set obj = Worksheets(dstSheet).Cells.Find(name) '名前を転記先の中で検索(1) End If '(1)の終了 If obj Is Nothing Then '検索でかからなかったら、新たに空白の行を見つけて転記元から転記先へ転記する(3) '以下3行問題点???? dstRow = dstSheet.Range("G" & Rows.Count).End(xlUp).Row + 1 '転記先行取得 If dstSheet.Range("E2") = "" Then dstRow = 1 '質問で転記先には1行目からなので、それに対応 dstSheet.Range("E" & dstRow).Resize(1, 3).Value = srcSheet.Range("E" & srcRow).Resize(1, 3).Value 'データ転記 End If Else '検索でかかったら、該当の行のアドレスを割り出し、特定の範囲を上書きする。(4) lngYLine = obj.Row intXLine = obj.Column With Sheets(dstSheet) '検索でかかったら、該当の行のアドレスを割り出し、特定の範囲を上書きする。(4) dstSheet.Range("E" & lngYLine).Resize(1, 3).Value = srcSheet.Range("E" & srcRow).Resize(1, 3).Value 'データ転記(4) End If '(3),(4)の終了 Set obj = Nothing 'Objの初期化 Next End Sub

  • エクセル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)空白行を作り、それ以降転記を実行し蓄積を行ってしまう。 入力シートには結合セル、リストを使用していますが、原因究明を行う中でこれが原因とは思えませんでした。 これがクリアできないと先に進めません。ぜひお力を貸してください。 宜しくお願い申し上げます。

  • Excel VBAで…。

    データーシート(1)のデータをレイアウトシート(2)に転記するのに 例えば sheets(1).range("A1").value=sheets(2).range("C5").value sheets(1).range("B1").value=sheets(2).range("C6").value sheets(1).range("C1").value=sheets(2).range("C7").value と言うように配置しているのですが もし、シート(1)セルB1の値が空白ならば シート(1)セルC1の値はシート(2)のセルC6に配置・・・ と言うように データがない場合は、転記後の配置は詰めて配置したいのです。 どうすればよろしいでしょうか?

  • エクセルVBAについての質問です。

    エクセルVBAについての質問です。  動作環境は  OS:WINDOWS XP  エクセル2003  です。 今、Book1.xlsというエクセルファイルがあります。 このファイルの中に、【sheet1】,【sheet2】,【sheet3】の3つのシートが存在しています。 【sheet1】および【sheet2】には、A列=ユニーク番号、B列=データ1、C列=データ2・・・・n列=データnの値が約1500行(各行で、データの値は異なります。)入っています。 この【sheet1】と【sheet2】のデータの内容を照合して【sheet3】にその結果を反映(TRUEまたはFALSE)します。 仮に【sheet3】のあるセル(仮にD3)の値がTRUEとなったら、【sheet1】のセル(D3)の値を【sheet3】のセル(D3)に代入する。 逆に【sheet3】のあるセルの値がFALSEとなったら、そのセルはFLASEのままにする。プログラムは以下の様にしたのですが、全てを処理するまでに相当時間がかかっています。 VBAのプログラムは今回初めて書いたので、プログラムが悪いのか、プログラムの思想が悪いのかがわかりません。 どなたかご教授していただけませんか?多分、コードの書き方もキレイではないと思います(悲) Private Sub データ照合ボタン_DblClick(ByVal Cancel As MSForms.ReturnBoolean) Dim i As Long Dim area As Range Dim A As Variant Dim WrkRange As String '----シート(1)とシート(2)の各セルの値を比較---- With Sheets("sheet1") WrkRow = .Cells(Rows.Count, 3).End(xlUp).Row End With Sheets("sheet3").Select For i = 12 To WrkRow WrkRange = Range("C" & i).Select ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)" WrkRange = Range("D" & i).Select ActiveCell.FormulaR1C1 = "=EXACT('sheet1'!RC,'sheet2'!RC)" '・           '・           '・ Next i A = i - 1 Sheets("sheet1").Select For i = 12 To A WrkRange = Range("C" & i).Select Selection.Copy Range("C" & i).PasteSpecial xlPasteValues Sheets("sheet3").Select If Range("C" & i) = True Then Sheets("sheet1").Select Range("C" & i).Copy Sheets("sheet3").Select Range("C" & i).Select ActiveSheet.Paste Else: End If Next i A = i - 1 Sheets("sheet1").Select For i = 12 To A WrkRange = Range("D" & i).Select Selection.Copy Range("D" & i).PasteSpecial xlPasteValues Sheets("sheet3").Select If Range("D" & i) = True Then Sheets("sheet1").Select Range("D" & i).Copy Sheets("sheet3").Select Range("D" & i).Select ActiveSheet.Paste Else: End If Next i          '・          '・          '・    End Sub

  • VBA 最終行を選んだシートにコピーする。

    VBAど初心者です。どうしても最終行のデータを選んだシートにコピーできません。 LastRow.Selectのところで、止まってしまいます。どのように行を設定していいのかさっぱりわかりません。どなたか、ご指導のほどよろしくお願いします。 Sub copy_last_line() Dim LastRow As Long Sheets("Sheet1").Select LastRow = Cells(Rows.Count, 1).End(xlUp).Row LastRow.Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Sheets("Sheet1").Select Range("A1").Select 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

  • エクセル2000のVBAで、入力セルのデータを転記したい

    シート1の5行目あたり(例えばBの5)に入力用セルを置き、値を入れてボタンを押したら 11/6の部分にその値が表示されるようにしたい。 同じシート1の10行目に題名を入れている(下記ではABCD・・・の部分) 11行目からデータ内容を下に記載していく。 10    A      B     C       D 11 2007/11/1 $2000 月平均  半月平均 12 2007/11/2 $2300 月平均  半月平均 13 2007/11/3        月平均  半月平均 14 2007/11/4 $2350 月平均  半月平均 15 2007/11/5        月平均  半月平均 16 2007/11/6        月平均  半月平均 このデータは日付A列がもともと入っています。 毎日の為替相場をデータにしていきたいと考えてください。 土日祝日等は入力しませんので、入力しない日(休祝日だった場合)はそのまま空欄に していくと言う形です。11/5が休みだといって11/4の次のセルを11/6にすると言うのではありません。 1年365日あるのでデータとしては日付部分に365行分先に入力されている形です。 Bだけが空欄で、CとDはアベレージ計算式が入っています。 下のマクロを組みましたが、これだと17行目の指定した列から入力されてしまいます。 どのようにしたらいいのか教えていただけますか? 入力セルに日付も必要ですか? Sub ボタン1_Click() Application.ScreenUpdating = False Sheets("シート1").Select Range("B5").Select Selection.Copy Sheets("シート1").Select Range("A65536").Select Selection.End(xlUp).Select Selection.Offset(1, 0).Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Application.CutCopyMode = Flase Sheets("シート1").Select Range("C10").Select Selection.ClearContents Range("B5").Select End Sub

  • 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の値)が出来ません。 どこが間違いか教えていただけないでしょうか。

  • マクロでシート2~6のデータをシート1に転記したい

    マクロでシート2~6のデータをシート1に転記したいです。 シート2~6のデータを シート1に順番に転記したくてマクロの記録を利用して作成しました。 シート2~6は列は同じですが行数は異なります。 また行数は作業の都度異なります。 同じ記述が繰り返されているので もう少し記述が短くできるのではと思うのですが どうすればいいでしょうか? Sub データ更新() 'シート1の前回データをクリア Sheets("シート1").Select Range("A2:Q2").Select Range(Selection, Selection.End(xlDown)).Select Range(Selection, Selection.End(xlDown)).Select Selection.ClearContents Range("A2").Select Sheets("シート1").Select Range("A1").Select Sheets("シート2").Select Range("A1").Select 'ヘッダーも合わせて取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート3").Select Range("A2").Select 'データのみ取得 Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート4").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート5").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select Sheets("シート6").Select Range("A2").Select Range(Selection, Selection.End(xlToRight)).Select Range(Selection, Selection.End(xlDown)).Select Selection.Copy Sheets("シート1").Select ActiveSheet.Paste Application.CutCopyMode = False Selection.End(xlDown).Select Selection.Offset(1, 0).Select End Sub

  • エクセルのマクロについての質問です。

    データをまとめるためのシートを追加し、 一つのブックにある全てのシートのBX6~CG15の範囲をA1を起点に下方向にコピー、 同様に同じブックにある全てのシートのC59~M68の範囲をK1を起点に下方向にコピーするというものを組んでみたのですが、C59~M68の範囲をまとめたものには範囲内の空白のセルも入っていますが、BX6~CG15の範囲をまとめたものは空白のセルが消えてしまいます。 この処理のあとに、A列が空白の行を削除するというものを入れたいので、できればどちらの範囲とも空白を入れたまままとめたいのです。 この空白のセルを消さずにまとめる方法がわかりません。 色々と調べて試していますがうまくいきません。 どこを修整するといいのでしょうか? 超初心者でコードの内容がまだまだわかっていません。 簡単な質問かもしれませんがご教示お願いします。 Sub Macro1() Dim sno As Integer Dim I As Integer sno = Worksheets().Count Sheets(1).Select Sheets.Add For I = 2 To sno + 1 Sheets(I).Range("BX6:CG15").Copy Sheets(1).Range("A65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste Next For I = 2 To sno + 1 Sheets(I).Range("C59:M68").Copy Sheets(1).Range("L65535").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste Next End Sub

専門家に質問してみよう