Suppression de toutes les lignes contenant du texte spécifique sur plusieurs feuilles

Question

J'ai quatre feuilles avec des données brutes que je voudrais copier dans mon classeur et les laisser seules pour la référence croisée. Ensuite, je voudrais supprimer toutes les lignes au-dessus de la cellule avec le texte "proj def" (il apparaît deux fois, mais il y a des cellules qui se trouvent entre les deux apparences - ce qui sera évident dans mon code). Je voudrais le faire pour les quatre premières feuilles de mon classeur tout en laissant les feuilles de calcul dupliquées d'origine seul, mais je ne peux le faire avec la première feuille de travail étiqueté "ptd". J'ai essayé d'activer la feuille de travail suivante "ytd" et même supprimer la feuille de calcul originale "ptd" pour voir si cela me permettrait de changer l'emplacement de myRange mais je n'ai eu aucun succès. Essentiellement, je veux exécuter ce code dans des sous-méthodes, deux pour la première feuille "ptd", deux de plus pour la deuxième feuille "ytd", un autre 2 pour "qtr" et le final 2 pour "mth". Toute modification à mon exemple de code serait très appréciée.

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

Si je comprends bien, ce qui suit devrait fonctionner. La chose principale que j'ai faite était de réécrire avec 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