消息框，搜索，複製並粘貼到新工作表並重復

Question

這是我用於我的Excel電子表格「產品數據庫」的代碼。它工作正常，我只需要它以某種方式繼續「循環」。在我搜索我要查找的產品之後是消息框，它將其複製並粘貼到另一個工作表中，並且它向下一行。然後，當我再次搜索時，它會刪除之前搜索的內容。

這裏是代碼：

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所以每次從2 計數使用吹代碼 -

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

但是你可以改變柱（A）爲每需要。