2017-03-03 1 views
0

문서의 열 E에서 특정 용어를 검색하려고하면 발견 된 전체 행을 다른 열에 복사하려고합니다 동일한 문서의 시트. 아래 코드는 내가하려는 일을 완료 할 수 있지만, 검색의 첫 번째 항목에 대해서만 수행하고 모든 항목이 발견되어 복사되고 붙여 넣기 될 때까지 계속해야합니다. 모든 도움이 크게 감사하겠습니다.특정 용어에 대해 1 열을 검색하고 전체 행을 다른 시트에 복사 할 때

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 

답변

0

원하는 것을 얻기 위해 루프를 사용해야합니다. 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 
관련 문제