特定の用語に対して1列を検索し、行全体を別のシートにコピーする場合

Question

文書の列Eで特定の用語を検索しようとしていますが、見つかった場合は、同じ文書内のシート。以下のコードは、私がしようとしていることを完了することができますが、検索の最初の出現に対してのみ行い、すべての出現が見つかってコピー＆ペーストされるまで続ける必要があります。すべての助けは大いに感謝されます。

Sub Macro3() 
    Dim LSearchRow As Integer Dim LCopyToRow As Integer 
    On Error GoTo Err_Execute 
    'Start search in row 2 LSearchRow = 2 
    'Start copying data to row 2 in Sheet2 (row counter variable) LCopyToRow = 2 
    While Len(Range("A" & CStr(LSearchRow)).Value) > 0 
     'If value in column E = "Aries Radio Control", copy entire row to Sheet2 
     If InStr(1, Range("E" & CStr(LSearchRow)).Value, "Aries Radio Control") > 0 Then 
      'Select row in Sheet1 to copy 
      Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
      Selection.Copy 
      'Paste row into Sheet ARC in next row 
      Sheets("ARC").Select 
      Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
      ActiveSheet.Paste 
      'Move counter to next row 
      LCopyToRow = LCopyToRow + 1 
      'Go back to Sheet1 to continue searching 
      Sheets("sheet1").Select 
     End If 
     LSearchRow = LSearchRow + 1 
    Wend 
    'Position on cell A3 Application.CutCopyMode = False Range("A3").Select 
    MsgBox "All matching data has been copied." 
    Exit Sub 
    Err_Execute: MsgBox "An error occurred." 
End Sub 

Answer 1

あなたが望むものを達成するためには、ループを使用する必要があります。 MSDN https://msdn.microsoft.com/en-us/library/office/ff839746(v=office.15).aspx#Anchor_2の例を次に示します。

This example finds all cells in the range A1:A500 on worksheet one that contain the value 2 and changes it to 5. 

With Worksheets(1).Range("a1:a500") 
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
     firstAddress = c.Address 
     Do 
      c.Value = 5 
      Set c = .FindNext(c) 
     Loop While Not c Is Nothing And c.Address <> firstAddress 
    End If 
End With