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