メッセージボックスで新しいワークシートに検索、コピー、貼り付けを繰り返して

Question

これは私のExcelスプレッドシート「製品データベース」に使用しているコードです。それはうまく動作し、ちょうどある方法で "ループ"を続ける必要があります。私が探している製品を検索した後、メッセージボックスが表示され、それを別のワークシートにコピーして貼り付け、1行下に移動します。それから私が再び検索すると、以前検索したものが消去されます。ここ

はコードです：

Sub Test2() 
Dim myWord$ 
myWord = InputBox("What key word to copy rows", "Enter your word") 
If myWord = "" Then Exit Sub 

Application.ScreenUpdating = False 
Dim xRow&, NextRow&, LastRow& 
NextRow = 2 
LastRow = Cells.Find(what:="*", After:=Range("A1"), SearchORder:=xlByRows, 
SearchDirection:=xlPrevious).Row 
For xRow = 1 To LastRow 
If WorksheetFunction.CountIf(Rows(xRow), "*" & myWord & "*") > 0 Then 
Rows(xRow).Copy Sheets("Heather").Rows(NextRow) 
NextRow = NextRow + 1 
End If 
Next xRow 
Application.ScreenUpdating = True 

MsgBox "Macro is complete, " & NextRow - 2 & " rows containing" & vbCrLf & _ 
"''" & myWord & "''" & " were copied to Heather.", 64, "Done" 
End Sub 

Answer 1

あなたはNextRow = 2ので、あなたがあたりとして、列（A）を変更することができますしかし、それは

NextRow = Sheets("Heather").Range("A" & Rows.Count).End(xlUp).Row 

コード - 2. 使用ブローから数えるたびに宣言しています必要。