エクセルVBA 検索結果を隣のシートの最終行に転記したい。

VBA初心者です。ワークシート2（ws2）で検索した検索結果（9行目B～E列に表示された値）を、ワークシート1（ws1）D～G列の最終行に貼り付けるにはどうしたらよいでしょうか？

単にws2の９行目の値（検索値ではない）をws1へ貼り付けることはできたのですが（下記）、検索結果のコードをどう書くのかわかりませんでした。下記をどのように書き換えればよいか教えていただきたく、どうぞよろしくお願いいたします。

Sub 転記()
　Dim ws1 As Worksheet
　Dim ws2 As Worksheet
　　　Set ws1 = Worksheets(1)
　　　Set ws2 = Worksheets(2)

　Dim lastRow As Long
　　　lastRow = ws1.Cells(Rows.Count,"d").End(xlUp).Row + 1

　With ws1
　　　.Cells(lastRow, 4) = ws2.RAnge("B9")
　　　.Cells(lastRow, 5) = ws2.RAnge("C9")
　　　.Cells(lastRow, 6) = ws2.RAnge("D9")
　　　.Cells(lastRow, 7) = ws2.RAnge("E9")
　End With
End Sub

質問者からの補足コメント

• 検索結果はワークシート2の9行目に表示された値と書いてしまったのですが、検索値は9行目の固定行ではなく、フィルター検索で、見出し行8行目の次の行に出て来た行です（フィルター検索で8行目の次の行に出て来た、例えば12行目とか130行目とか）。
  
  ワークシート2、見出し行：B8番号、C８氏名、D８日付、E記号
  
  現在は、ワークシート2　B8に番号を入れフィルター検索、検査値（出て来た行）のＤ列に日付を入れて、B～Ｅ列を手でコピーして、ワークシート1のＤ～Ｇ列の最終行に貼り付けをしています。
  
  検索で出て来た行のワークシート2のＢ～Ｅ列をワークシート1のＤ～Ｇ列の最終行へボタンを押したら自動で貼り付けする。or　ワークシート２のＤ８日付に新しく日付が入った行を、ボタンを押したらワークシート1のＤ～Ｇ列の最終行へボタンを押したら自動で貼り付けする。のどちらかができたらたいいな、と思っておりました。

    補足日時：2025/03/01 18:38

No.6 回答者： tatsumaru77 回答日時： 2025/03/03 10:52

ちょっと強引ですが、以下でどうでしょうか。

Public Sub 転記()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim lastrow2 As Long
Dim row2 As Long
Set ws1 = Worksheets(1)
Set ws2 = Worksheets(2)
If ws2.AutoFilterMode = False Then
MsgBox ("フィルターなし")
Exit Sub
End If
lastrow = ws1.Cells(Rows.Count, "d").End(xlUp).Row + 1
lastrow2 = ws2.Cells(Rows.Count, "B").End(xlUp).Row
For row2 = 9 To lastrow2
If Not Application.Intersect(ws2.Cells(row2, "B"), ws2.AutoFilter.Range.SpecialCells(xlCellTypeVisible)) Is Nothing Then
ws1.Cells(lastrow, 4).Resize(, 4).Value = ws2.Cells(row2, "B").Resize(, 4).Value
Exit For
End If
Next
End Sub

この回答へのお礼

できました！初心者なので、コードは理解できないのですが、できたので満足です！ありがとうございました！！！

お礼日時：2025/03/03 21:06

No.5 回答者： アルムの森の木 回答日時： 2025/03/02 09:48

下の回答を書いた後、思い出しました。

VBAを使ってフィルタを掛けた後、タイトル行を除くデータを選択し、貼り付けるプログラムを書けば、出来るはずです。

具体的なプログラムコードにつきましては、そらで書くことが出来ず、ヒントのみで申し訳ありません。

この回答へのお礼

VBAを使ってフィルタを掛ける、のコードも書けないもので、、、。
フィルタを使って出て来た結果のその1行だけ、VBAで自動コピペできないかな？と思ったのですが、初心者にはなかなかハードル高いことを理解しました。

ChatGPTでコードを書けるようなのですが、お恥ずかしながら、まだChatGPT使えず、そのあたりから、ちょっと取り組んでみようかなと思います。

ご連絡に感謝いたします。

お礼日時：2025/03/02 16:02

No.4 回答者： アルムの森の木 回答日時： 2025/03/02 09:40

１つ下のセルを指定する「Offset」というコードがあるんですが、フィルタが掛かっている場合は使えないのでしょうか？

もしくは、VBAを使ってフィルタを掛けたら、出来ませんでしょうか？

No.3 回答者： アルムの森の木 回答日時： 2025/03/01 13:05

検索した結果を、ワークシート２の９行目に入力するためのプログラムコードを書いて、今のプログラムに継ぎ足せばいいと思います。

この回答へのお礼

お礼日時：2025/03/01 18:39

No.2 回答者： fujillin 回答日時： 2025/02/28 18:52

こんばんは

＞検索結果（9行目B～E列に表示された値）を、
＞ワークシート1（ws1）D～G列の最終行に貼り付ける～～
検索結果が必ず9行目固定で表示される仕組みになっていて、それを転記したいというのなら、ご提示のコードで転記できるはずです。

固定行ではなく、どこかの行に表示されているというのであれば、その行をどうやって特定するのかが不明なので、何とも回答のしようがありません。
あるいは、「検索処理そのものをVBAで行いたい」という事なのかもしれませんけれど、その場合は「どこから、何を、どのように検索するのか」がまったく示されていないので、更に何ともしようがありません。


ついでながら、ご質問の文章とご提示のコードの間にもニュアンス的に若干の違いがありそうなので、老婆心ながら・・
・「ワークシート2」、「ワークシート1」との記載ですが、コードはブックの左から順に1番目、2番目のシートを採用していますので、シート名で指定したい場合には必ずしも正確ではありません。
（シートが常にその順で並んでいれば一致します）

・「D～G列の最終行に貼り付ける」とありますが、コードでは「Ｄ列の最終行の次の行」に転記するようになっています。
（「Ｄ~Gの最終行」が常にＤ列で代表でき、また、その次の行で良い
　のなら問題はありません。
　特に、Ｄ列に空白セルが存在する可能性がある場合は、意図と異なる
　結果になることがありそうです。）

・連続するセル値を転記する場合には、Rangeオブジェクトを利用してまとめて転記するような記法にした方が簡単に記述できますし、処理も若干ながら速くなります。
（たかだか4セル分なので、差はないとも言えますが・・）

No.1 回答者： amerikaumare 回答日時： 2025/02/28 17:10

こういうのは得意なんですが　歳で面倒くさくなったので ChatGPTに丸投げしました。

　以下はその回答です。

検索結果を貼り付けるコードの書き換え方法について、ポイントは 検索結果の範囲を直接コピーして貼り付ける ことです。

もし ws2の9行目B～E列に表示された検索結果の範囲 をそのまま ws1のD～G列の最終行 に貼り付けたい場合は、次のようにコードを書き換えるとシンプルに実現できます。

Sub 転記()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets(1) ' ワークシート1
Set ws2 = Worksheets(2) ' ワークシート2

Dim lastRow As Long
lastRow = ws1.Cells(ws1.Rows.Count, "D").End(xlUp).Row + 1 ' ws1のD列の最終行を取得

' 検索結果の範囲を貼り付け
ws2.Range("B9:E9").Copy ' ws2のB9～E9をコピー

ws1.Cells(lastRow, 4).PasteSpecial Paste:=xlPasteValues ' D列の最終行に値のみ貼り付け

Application.CutCopyMode = False ' コピー範囲の点線を解除
End Sub


・ポイント解説
１．　ws2.Range("B9:E9").Copy
　　　→ ws2のB9～E9の検索結果をコピーしています。
２．　PasteSpecial Paste:=xlPasteValues
　　　→ 値のみを貼り付けるので、書式などは反映されません。
３．　Application.CutCopyMode = False
　　　→ コピー後の点線表示を解除するおまじないです。

・もし書式も一緒に貼り付けたい場合

ws1.Cells(lastRow, 4).PasteSpecial Paste:=xlPasteAll
に変更すれば、書式も含めてそのまま貼り付けできます！

これで検索結果の範囲をきれいに貼り付けられるはずです！
試してみてください