特定のワードを含む行を抽出して別のワークシートに出力するマクロ

Question

前提・実現したいこと

エクセルで以下のような表がsheet1に記載されているとき
例えば商品ラベル列で「100」が含まれている商品ラベル行のみ抽出し、隣のシート(sheet2)へ書き出すマクロを描きたいのですが
やりかたを教えていただけますでしょうか？

商品ラベル	値段(円)	割引
a_100_果物	300	5
a_101_食器	500	5
a_120_植物	100	0
a_103_果物	400	10
b_100_食器	500	15

（このようなシートが下に1000行ほどつづきます。）

以下の部分までマクロを書いているのですが、抽出条件の部分の書き方がわかりません。

sub filter_and_write()

sheet2.ClearContents '出力先のsheet2の値をすべてクリアしておく

Dim rowsData As Long '行数カウント用の変数
rowsData = sheet1.Cells(Rows.Count, 1).End(xlUp).Row '最後の行数を取得

lael_code = Application.InputBox("抽出したい商品ラベルの番号を入力してください", "商品ラベルに含まれる番号を入力")　'ここで100と入力するようなメッセージボックスを作る

Dim i As Long, k As Long
k = 1 '出力先のセルの始点
For i = 2 To rowsData
    label_data = sheet1.Cells(i, 1).Value
    If ”label_dataに「label_code」が含まれている場合” Then
        sheet1.Range(sheet1.Cells(i, 1), sheet1.Cells(i, 3)).Copy sheet2.Cells(k, 1)　'1行ごとにsheet2へコピーする
        k = k + 1
    End If
Next i　 
endsub

補足情報（FW/ツールのバージョンなど）

excel 2016

Answer 1

解決済みですがこういうことでしょうか・・。

Sub filter_and_write()
Dim rowsData As Long '行数カウント用の変数
Dim label_code As string
Dim mylabel As integer
Dim mylabel_data As integer
Dim i As Long, k As Long

Sheet2.Range("A1").ClearContents '出力先のsheet2の値をすべてクリアしておく

rowsData = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row '最後の行数を取得

label_code = Application.InputBox("抽出したい商品ラベルの番号を入力してください", "商品ラベルに含まれる番号を入力")  'ここで100と入力するようなメッセージボックスを作る

mylabel = Mid(label_code, 3, 3) 'Inputboxから番号のみを抽出

k = 1 '出力先のセルの始点
For i = 2 To rowsData
    
    label_data = Sheet1.Cells(i, 1).Value
    mylabel_data = Mid(label_data, 3, 3) '商品ラベルから番号のみを抽出

    If mylabel = mylabel_data Then '比較
        Sheet1.Range(Sheet1.Cells(i, 1), Sheet1.Cells(i, 3)).Copy Sheet2.Cells(k, 1)  '1行ごとにsheet2へコピーする
        k = k + 1
    End If
Next i
End Sub

Answer 2

オートフィルターを使う方法も参考にどうぞ。

Sub filter_and_write()

Dim label_code As Long

Sheet2.Cells.ClearContents

label_code = Application.InputBox("抽出したい商品ラベルの番号を入力してください", "商品ラベルに含まれる番号を入力")  'ここで100と入力するようなメッセージボックスを作る

With Range("a1").CurrentRegion
    .AutoFilter field:=1, Criteria1:="*" & label_code & "*"
    .Copy Sheet2.Range("a1")
    .AutoFilter
End With

End Sub

Comments

[loreeeee]

オートフィルターの使い方を教えていただきありがとうございます。上記マクロを実行したところ、
オブジェクト'AtoFilter'のメソッド'Range'が失敗しました
とメッセージがでます。これはどういった要因なのでしょうか？

[radames1000]

'AtoFilter'と書かれてますが、「Autofilter」が正しいです。
正しく入力されていますか？コピペでいけると思うのですが・・・

[radames1000]

まだ何か不具合が出ていますか？

[loreeeee]

失礼しました。上記の修正で動作が確認できました。
回答いただきありがとうございました。

Answer 3

    If InStr(label_data, label_code) > 0 Then  'label_dataにlabel_codeが含まれている場合、見つかった先頭位置が返る（見つからないとゼロが返る）

ですね。