シートにあるキーワードを別のシートで検索し、該当する行（複数行）を新ブックに貼り付けたい

質問

今週から勉強を始めたくらいのマクロ初心者なので言っている事が分かりにくかったらすみません。
エクセルVBAでマクロを組んでいるのですが、
Sheet1にあるキーワード（B3～）をSheet2の指定の列で検索し、
そのキーワードが含まれている行を新しいブックにコピーするものを作成したいです。
どうやっても検索とシートのコピーのところがうまくいかず、Sheet2の行数が2万ぐらいあるのでどの方法で検索をしたらいいのか困っています。
とりあえずブック内にシートを1つ作って、そこにヒットした行を貼り付け新しいブックにコピーすればいいのかと思いやっているのですが、動きません…
以下に現時点でのソースを記載するのでどこがまずいのか助言宜しくお願いします。

Sub kensaku()

Dim key As String
Dim target As String
Dim x As Integer
Dim y As Long
Dim z As Long

x = 3
y = 10
z = 1

Set sh = Worksheets.Add
sh.Name = "kekka"

key = Worksheets("Sheet1").Range("B" & x).Value
Do Until Worksheets("Sheet1").Range("B" & x) = ""
target = Worksheets("Sheet2").Range("F" & y).Value
Do Until Worksheets("Sheet2").Range("F" & y) = ""
If target = key Then
Worksheets("Sheet2").Rows(y).Select
Selection.Copy
Sheets("kekka").Rows(z).Activate
Activesheet.Paste
z = z + 1
End If
y = y + 1
Loop
x = x + 1
Loop

Worksheets("kekka").Copy

Application.DisplayAlerts = False
Worksheets("kekka").Delete
Application.DisplayAlerts = True

End Sub

回答No.1

hana-hana3 · ベストアンサー

＞そのキーワードが含まれている行を新しいブックにコピーするものを作成したいです。

オートフィルタでキーワードの文字を絞り込んでから、表の範囲をコピーして別のシートに貼り付けを行う方が簡単で早いですよ。

フィルタで絞り込んでコピーし、別シートに貼り付けと言う作業を記録マクロにして、思い通りに動くように編集してみてはいかがでしょうか？