
こんにちは。いつもお世話になっております。
VBAを勉強しているのですが、まだまだわからないことだらけでして教えていただきたいです。
他のかたの質問や回答を見ているのですが、ぴたっとハマるものがなく。
どなたか教えて頂けると嬉しいです。どうぞよろしくお願いいたします。
【やりたいこと】
・月次報告書のB2に対象月を入力し該当の月別シートを検索したい
・月別シートの該当商品カテゴリがある行をピックアップして月次報告書シートに貼り付けたい
【条件】
貼り付け元の月別シート
商品項目列:I列
該当商品名:ゼリー パイ デコレーション の3種類
貼り付けたい項目:B(ID),C(作業内容),E(工数),F(依頼日),G,H 列の6項目
貼り付け先の月次報告シート
B3:G3にタイトルが入っており、4行目以降に転記をしていきたい。

No.1ベストアンサー
- 回答日時:
こんにちは
不明点は適当ですが、こんな感じでしょうか?
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
ありがとうございます!!
コピっただけで出来てしまいました。
中身でまだ理解できていない部分があるので調べてみようと思います!
本当にありがとうございました。
No.2
- 回答日時:
こんばんは
>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となる)
回答が出ているので参考程度で
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教える店舗&オフィスのセキュリティ対策術
中・小規模の店舗やオフィスのセキュリティセキュリティ対策について、プロにどう対策すべきか 何を注意すべきかを教えていただきました!
-
vba 2つの条件が一致したらコピーして別シートに値のみ貼り付け
Visual Basic(VBA)
-
複数条件が一致で別シートに転記【エクセルVBA】
Excel(エクセル)
-
VBA 値と一致した行の一部の列のデータを転記について教えてください
Visual Basic(VBA)
-
-
4
VBA 条件が一致したら別シートに転記し、計算させたい
Visual Basic(VBA)
-
5
別のシートから値を取得するとき
Visual Basic(VBA)
-
6
VBA別シートの最終行の次行へ転記したい。
Visual Basic(VBA)
-
7
VBA シート名が一致した場合の転記内容について
Visual Basic(VBA)
-
8
VBAで条件が一致する行のデータを別シートに抽出
Excel(エクセル)
-
9
【VBA】特定の値が入った行をコピーして別シートに貼り付ける方法をおしえていただきたいです。
Excel(エクセル)
-
10
EXCEL VBAで全選択範囲の解除
Excel(エクセル)
-
11
ExcelVBAを使って、値がある場合は作業を繰り返し実行するプログラムを作成したい。
Visual Basic(VBA)
-
12
VBA 日付一致で転記
Visual Basic(VBA)
-
13
VBAを使って検索したセルをコピーして別の場所に貼り付ける。
Visual Basic(VBA)
-
14
マクロで「別シートを検索・元シートへ転記」したいのですが・・・
Access(アクセス)
-
15
Exel VBA 別ブックから該当データを検索し、必要なデータを取得する方法について
Visual Basic(VBA)
-
16
エクセル VBA find は別シートを検索できますでしょうか?
Excel(エクセル)
-
17
VBA 別シートの同じ日付の欄に値を貼付け
Excel(エクセル)
-
18
[初心者です]VBAで指定列からAを検索し、発見したら隣のセルに値0を入れるマクロ。
Access(アクセス)
-
19
【VBA】指定したセルと同じ値で、別シートにあるセルに移動するには?
Visual Basic(VBA)
-
20
条件にマッチする行を抽出するVBAを教えてください
経営情報システム
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
人気Q&Aランキング
-
4
セルのコピーで「オブジェクト...
-
5
エクセルのシート名変更で重複...
-
6
ブック名、シート名を他のモジ...
-
7
【ExcelVBA】全シートのセルの...
-
8
excelのマクロで該当処理できな...
-
9
コマンドボタンをクリックでシ...
-
10
実行時エラー'1004': WorkSheet...
-
11
エクセルのマクロでアクティブ...
-
12
ユーザーフォームに入力したデ...
-
13
Excelにて、シート間で、データ...
-
14
VBA 最終行まで数式をコピーする
-
15
Excel チェックボックスにチェ...
-
16
VBAで指定シート以外の選択
-
17
EXCEL VBAで複数シートから該当...
-
18
ExcelVBA:複数の特定のグラフ...
-
19
【EXCEL】ワークシートの名前を...
-
20
Excel VBA リンク先をシート...
おすすめ情報
公式facebook
公式twitter