Alle Zeilen entfernen, die bestimmten Text über mehrere Blätter hinweg enthalten

Question

Ich habe vier Blätter mit Rohdaten, die ich in meiner Arbeitsmappe duplizieren möchte und die für Querverweise allein gelassen werden. Dann möchte ich alle Zeilen über der Zelle mit dem Text "proj def" entfernen (es erscheint zweimal, aber es gibt Zellen, die zwischen den beiden Erscheinungen liegen - was in meinem Code ersichtlich sein wird). Ich möchte dies für die ersten vier Blätter meiner Arbeitsmappe tun, während ich die ursprünglichen duplizierten Arbeitsblätter allein lasse, aber nur mit dem ersten Arbeitsblatt mit der Bezeichnung "ptd". Ich habe versucht, das nächste Arbeitsblatt "ytd" zu aktivieren und sogar das ursprüngliche Arbeitsblatt "ptd" zu löschen, um zu sehen, ob es mir erlauben würde, den Standort von myRange zu ändern, aber ich hatte keinen Erfolg. Im Wesentlichen möchte ich diesen Code in Untermethoden ausführen, zwei für das erste Blatt "ptd", zwei weitere für das zweite Blatt "YTD", eine weitere 2 für "Qtr" und die letzten 2 für "Mth". Alle Änderungen an meinem Beispielcode würden sehr geschätzt werden.

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

Wenn ich richtig verstehe, sollte das folgende funktionieren. Die Hauptsache, die ich getan habe, war mit avoiding the use of .Select/.Activate neu schreiben.

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