【VBA】指定した検索条件に一致したら別シートに転記したい

こんにちは。いつもお世話になっております。
VBAを勉強しているのですが、まだまだわからないことだらけでして教えていただきたいです。
他のかたの質問や回答を見ているのですが、ぴたっとハマるものがなく。
どなたか教えて頂けると嬉しいです。どうぞよろしくお願いいたします。

【やりたいこと】
・月次報告書のB2に対象月を入力し該当の月別シートを検索したい
・月別シートの該当商品カテゴリがある行をピックアップして月次報告書シートに貼り付けたい

【条件】
貼り付け元の月別シート
商品項目列：I列
該当商品名：ゼリー　パイ　デコレーション　の3種類
貼り付けたい項目：B（ID）,C（作業内容）,E（工数）,F（依頼日）,G,H 列の6項目

貼り付け先の月次報告シート
B3：G3にタイトルが入っており、4行目以降に転記をしていきたい。

No.1 ベストアンサー 回答者： fujillin 回答日時： 2022/03/23 18:35

こんにちは

不明点は適当ですが、こんな感じでしょうか？

Sub Q12864040()
Dim sht As Worksheet, sname
Dim tmp As String
Dim rw As Long, n As Long

sname = Split("ゼリー,パイ,デコレーション", ",")

With Worksheets("月次報告書")
tmp = .Range("B1").Text
For Each sht In Worksheets
If sht.Name = tmp Then Exit For
Next sht
If sht Is Nothing Then MsgBox "指定シートは存在しません": Exit Sub

.Cells(4, 2).Resize(Rows.Count - 3, 6).ClearContents
n = 4
For rw = 2 To sht.Cells(Rows.Count, 9).End(xlUp).Row
tmp = sht.Cells(rw, 9).Text
If tmp = sname(0) Or tmp = sname(1) Or tmp = sname(2) Then
.Cells(n, 2).Resize(, 2).Value = sht.Cells(rw, 2).Resize(, 2).Value
.Cells(n, 4).Resize(, 4).Value = sht.Cells(rw, 5).Resize(, 4).Value
n = n + 1
End If
Next rw

End With
End Sub

この回答へのお礼

ありがとうございます！！
コピっただけで出来てしまいました。
中身でまだ理解できていない部分があるので調べてみようと思います！
本当にありがとうございました。

お礼日時：2022/03/24 11:04

No.2 回答者： Qchan1962 回答日時： 2022/03/23 18:54

こんばんは

＞VBAを勉強しているのですが
すでに処理コードが提示されていますが、
条件の作り方の参考の為、少し違う方法も

該当シートが無い場合処理されません
Sub test()
Dim ws As Worksheet
Dim V(), r
Dim n As Long
For Each ws In Worksheets
If ws.Name = Worksheets("月次報告書").Range("B1").Text Then
For Each r In Range(ws.Cells(2, "I"), ws.Cells(Rows.Count, "I").End(xlUp))
If r.Value <> "" And "$ゼリー$パイ$デコレーション" Like "*" & r.Value & "*" Then
ReDim Preserve V(6, n)
V(0, n) = r.Offset(, -7)
V(1, n) = r.Offset(, -6)
V(2, n) = r.Offset(, -4)
V(3, n) = r.Offset(, -3)
V(4, n) = r.Offset(, -2)
V(5, n) = r.Offset(, -1)
n = n + 1
End If
Next
Worksheets("月次報告書") _
.Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(UBound(V, 2) + 1, UBound(V, 1)) _
= WorksheetFunction.Transpose(V)
Exit For
End If
Next
End Sub

$ゼリー$パイ$デコレーションの＄は単なるシンボルです
無くても良いですが、この方法（ If Like）ですとゼリーパイなどのキーワードでも抽出してしまいますので一応＄を付けました
r.Value <> ""　は　Like の弱点です　（空白の場合* & "" & * となり
すべてがTrueとなる）

回答が出ているので参考程度で