Поиск и копирование

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.