搜索和复制

Question

我正在尝试搜索关键字，找到后将单元格内容复制到名为list的工作表中。

我已经编写了所附的代码，但是它从未写入List工作表。而且，这些不是每个单元格中的单个单词条目，取决于单元格，它们最多可以是2个段落。

Sub Search()
'
' Search Macro
' Search for a specific key word
' Jeremy Simspon Sept 25 2019
 totalsheet = Worksheets.Count
 findWhat = CStr(InputBox("What word would you like to search for today?")) 'prompt user for input
 c = 1
 For i = 1 To totalsheet
 If Worksheets(i).Name <> "List" Then
    lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row
       For j = 1 To lastrow
      If InStr(Worksheets(i).Cells(j, 1).Value, findWhat) > 0 Then
     'Continue = MsgBox(("match"), vbYesNo + vbQuestion)
     'Worksheets("List").Activate
     lastrow = Worksheets("List").Cells(Rows.Count, 1).End(xlUp).Row
     Worksheets("List").Cells(lastrow + 1, 1).Value = Worksheet.Cells(j, 1).Value
        c = c + 1
      End If
     If InStr(Worksheets(i).Cells(j, 3).Value, findWhat) > 0 Then
     Worksheets(List).Activate
     Continue = MsgBox(("match"), vbYesNo + vbQuestion)
     lastrow = Worksheets(List).Cells(Rows.Count, 3).End(xlUp).Row
     Worksheets(List).Cells(lastrow + 1, 3).Value = Worksheet.Cells(j, 3).Value

     c = c + 1


      End If

    Next
  End If
     Continue = MsgBox(("lastrow =" & lastrow & " and i=" & i & " j= " & j), vbYesNo + vbQuestion)

 Next

        'Continue = MsgBox(totalsheet)
        Continue = MsgBox(((c - 1) & " results were copied, do you have more keywords to enter?"), vbYesNo + vbQuestion) 'prompt user to see if more input required

End Sub
~~~








I am trying to search a workbook with multiple sheets for a keyword, once the keyword is found in a cell, copy that cell to the Worksheet list.