여러 개의 시트에 대해 특정 텍스트가 포함 된 모든 행을 제거하십시오.

Question

통합 문서에 중복되고 상호 참조를 위해 남겨지는 원시 데이터가있는 시트가 4 개 있습니다. 그런 다음 "proj def"텍스트가있는 셀 위의 모든 행을 제거하고 싶습니다 (두 번 나타나지만 두 가지 모양 사이에있는 셀이 있습니다 - 내 코드에서 분명합니다). 원래 복사 한 워크 시트를 그대로 두면서 내 통합 문서의 첫 번째 네 장에는이 작업을 수행하고 싶지만 "ptd"라는 레이블이 붙은 첫 번째 워크 시트로만 수행 할 수 있습니다. 다음 워크 시트 "ytd"를 활성화하고 원래 워크 시트 "ptd"를 삭제하여 myRange의 위치를 ​​변경할 수 있는지 확인했지만 성공하지 못했습니다. 기본적으로 두 번째 시트 "ytd"에 2 개, "qtr"에 2 개, "mth"2 번째 시트에 대해 두 번째 시트 "ptd"에 대해이 코드를 하위 메서드로 실행하려고합니다. 내 샘플 코드에 대한 모든 수정 사항은 많이 감사하겠습니다.

Sub part1() 
    Worksheets("ptd").Copy After:=Worksheets("mth") 
    Worksheets("ytd").Copy After:=Worksheets("ptd (2)") 
    Worksheets("qtr").Copy After:=Worksheets("ytd (2)") 
    Worksheets("mth").Copy After:=Worksheets("qtr (2)") 
End Sub 
Sub part2() 
Worksheets("ptd").Activate 
Set rngActiveRange = ActiveCell 
      Dim MyRange As Range 
      Set MyRange = ActiveSheet.Range("A:A") 
      MyRange.Find("Customer Unit", LookIn:=xlValues).Select 
      rngActiveRange.Offset(-1, 0).Select 
      Range(rngActiveRange.Row & ":" & 1).Rows.Delete 
End Sub 
Sub part3() 
    Dim MyRange As Range 
    Set MyRange = ActiveSheet.Range("A:A") 
    MyRange.Find("Project Definition", LookIn:=xlValues).Select 
    ActiveCell.Offset(-1, 0).Select 
    Range(ActiveCell.Row & ":" & 1).Rows.Delete 
End Sub 
Sub part4() 
Worksheets("ytd").Activate 
Set rngActiveRange = ActiveCell 
      Dim MyRange As Range 
      Set MyRange = ActiveSheet.Range("A:A") 
      MyRange.Find("Customer Unit", LookIn:=xlValues).Select 
      rngActiveRange.Offset(-1, 0).Select 
      Range(rngActiveRange.Row & ":" & 1).Rows.Delete 
End Sub 
Sub part5() 
    Dim MyRange As Range 
    Set MyRange = ActiveSheet.Range("A:A") 
    MyRange.Find("Project Definition", LookIn:=xlValues).Select 
    ActiveCell.Offset(-1, 0).Select 
    Range(ActiveCell.Row & ":" & 1).Rows.Delete 
End Sub 

Answer 1

제대로 이해하면 아래 사항이 적용됩니다. 내가 한 가장 중요한 일은 avoiding the use of .Select/.Activate으로 다시 쓰는 것입니다.

Sub remove_Rows() 
Dim ws  As Worksheet 
Dim foundCel As Range 

' Copy sheets 
Worksheets("ptd").Copy After:=Worksheets("mth") 
Worksheets("ytd").Copy After:=Worksheets("ptd (2)") 
Worksheets("qtr").Copy After:=Worksheets("ytd (2)") 
Worksheets("mth").Copy After:=Worksheets("qtr (2)") 

' Start removing rows 
For Each ws In ActiveWorkbook.Worksheets 
    With ws 
     If InStr(1, .Name, "(") = 0 Then 
      Set foundCel = .Range("A:A").Find("Customer Unit", LookIn:=xlValues) 
      .Range(foundCel.Offset(-1, 0).Row & ":" & 1).Rows.Delete 
      Set foundCel = .Range("A:A").Find("Project Definition", LookIn:=xlValues) 
      .Range(foundCel.Offset(-1, 0).Row & ":" & 1).Rows.Delete 
     End If 
    End With 
Next ws 

End Sub