[땡큐엑셀vba & 엑셀매크로] Q열에서 NG나 LIMIT이 포함되있는 행을 추출해서 다른시트로 붙여넣기

​

​

결과

 

'Q열에서 NG나 LIMIT이 포함되있는 행을 추출해서 다른시트로 붙여넣어야합니다..
'ㅠㅠ ..매크로말고는 답이 없을것 같은데 부탁드릴게여..


'
'Source by 땡큐엑셀vba & 엑셀매크로
'
Sub 행추출복사()

    Dim ws2 As Worksheet
    Dim sht As Worksheet
    Dim oRng As Range
    Dim rng As Range
    Dim lastRow As Integer
    

    '순서
    '1.검색
    '2.루프돌며 찾은행 복사
    
        
    '검색어
    'findString = "jump"
    findString = Cells(6, "Q")
    If findStirng = "" Then
    
        MsgBox "검색어를 입력후 다시 시도해 보세요", vbInformation, "땡큐엑셀vba & 엑셀매크로"
        Exit Sub
    
    End If
    
    
      
    '화면 갱신 중지
    Application.ScreenUpdating = False
    
      
    

    '결과시트
    Set ws2 = Sheets("땡큐엑셀결과")
    
    '활성시트
    Set sht = ActiveSheet
    
    '활성시트의 Q열
    Set oRng = sht.Range("Q:Q")
    
    '땡큐엑셀결과 시트 clear
    ws2.Cells.Clear
    

    
    '1.검색
     Set rng = oRng.Find(what:=findString, lookat:=xlPart)

    
     If Not rng Is Nothing Then '검색결과가 있다면
         strAddr = rng.Address  '첫 위치를 기록
        
         '2.검색결과가 없을때 까지 루프돌며 찾은행 복사
         Do
            '마지막 행에 복사
             lastRow = ws2.Cells(Rows.Count, "A").End(3).Row + 1
             rng.EntireRow.Copy ws2.Cells(lastRow, "A")
                                    
             Set rng = oRng.FindNext(rng) '다음검색
         Loop While Not rng Is Nothing And rng.Address <> strAddr
     End If
            

    '열넓이 자동조절
    ws2.Columns.AutoFit
    
    '결과시트 활성화
    ws2.Activate

    '화면 갱신 재개
    Application.ScreenUpdating = True
    
    

    MsgBox "완료되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"

End Sub

​

 

검색어포함된행 추출하기-땡큐엑셀vba.xlsm

0.10MB