消息框，search，复制并粘贴到新的工作表并重复

这是我用于我的Excel电子表格“产品数据库”的代码。 它工作正常，我只是需要它继续“循环”的方式。 在我search产品后，我要查找的是消息框，它将其复制并粘贴到另一个工作表中，然后向下一行。 然后当我再次search时，它会擦除​​我以前search的内容。

这里是代码：

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）。