XL 2019 VBA copier lignes qui contiennent un mot et qui répondent à une condition

[MJE]

Bonjour,
Malgré mes nombreux essais et recherches, impossible de trouver une solution...

J'ai un fichier de suivi de plusieurs projets, chaque feuille contient les informations d'un projet. Et dans chaque feuille sont répartis des tâches qui sont attribuées à des personnes (voir colonnes L et M des feuilles projet).
En plus des feuilles projet (projet1, projet2), j'ai des feuilles pour chaque personne (MJE, NNU) qui doivent reprendre toutes les tâches attribuées à la personne tous les projets confondus.

Ce que je bloque à faire c'est par exemple, lorsque j'ouvre la feuille "MJE" j'aimerais avoir toutes les tâches des feuilles "projet1" et "projet2" qui concernent "MJE" ET qui sont toujours en cours (donc colonne Q < 100%) qui s'affichent.

J'espère avoir été assez claire, n'hésitez pas à me dire s'il manque des précisions.
Merci d'avance pour votre aide.

 

[job75]

Bonjour MJE, bienvenue sur XLD,

Le code de la feuille "MJE" :

Private Sub Worksheet_Activate()
Dim lig&
Application.ScreenUpdating = False
Cells.Delete 'RAZ
With Sheets("Projet1").[A1].CurrentRegion
    .Cells(2, .Columns.Count + 2) = "=ISNUMBER(SEARCH(""MJE"",L2))*(Q2<100)"
    .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 2).Resize(2), [A1] 'filtre avancé
    .Cells(2, .Columns.Count + 2) = ""
End With
lig = UsedRange.Rows.Count + 1
With Sheets("Projet2").[A1].CurrentRegion
    .Cells(2, .Columns.Count + 2) = "=ISNUMBER(SEARCH(""MJE"",L2))*(Q2<100)"
    .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 2).Resize(2), Range("A" & lig) 'filtre avancé
    .Cells(2, .Columns.Count + 2) = ""
End With
Rows(lig).Delete 'supprime la ligne d'en-têtes
Columns.AutoFit 'ajuste les largeurs
Columns("A:E").Hidden = True 'masque les colonnes
Rows(1).Font.ColorIndex = xlAutomatic 'police
End Sub

La macro se déclenche quand on active la feuille.

Le code de la feuille "NNU" est le même, ""MJE"" est juste remplacé par ""NNU"".

A+

 

[MJE]

C'est fantastique ! Merci beaucoup.
Je regarde en détail et j'aurais peut-être quelques questions concernant le code car je souhaite le comprendre.

 

[MJE]

Bonjour job75,

Encore merci, je reviens avec quelques questions.

Est-ce possible de coller avec le même format de cellule ? (couleur de remplissage, icones dans la colonne Q et éventuellement même largeur)

Dans le code:

With Sheets("Projet1").[A1].CurrentRegion
    .Cells(2, .Columns.Count + 2) = "=ISNUMBER(SEARCH(""MJE"",L2))*(Q2<100)"
    .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 2).Resize(2), [A1] 'filtre avancé
    .Cells(2, .Columns.Count + 2) = ""
End With

.Cells(2, .Columns.Count + 2) = "=ISNUMBER(SEARCH(""MJE"",L2))*(Q2<100)"
Je comprends que sur la ligne 2 et deux colonnes après mon tableau, on applique la formule "ISNUMBER(Search" qui va renvoyer 1 si les critères sont remplis et 0 si pas.
Ensuite on applique un filtre avancé pour copier uniquement les lignes qui nous intéressent. Mais je ne vois pas quel est la commande qui dit "copie les lignes qui répondent aux critères" ? Et que veut dire .Resize(2) ?

J'ai essayé de modifier le code avec cette formule à la place mais ça ne fonctionne pas :

With Sheets("Projet1").[A1].CurrentRegion
    .Cells(2, .Columns.Count + 2) = "OR(ISNUMBER(SEARCH(""MJE"",L2)),ISNUMBER(SEARCH(""MJE"",M2)))*(Q2<100)"
    .AdvancedFilter xlFilterCopy, .Cells(1, .Columns.Count + 2).Resize(2), [A1] 'filtre avancé
    .Cells(2, .Columns.Count + 2) = ""
End With

 

[job75]

Bonjour MJE,

Pour ce qui est du filtre avancé renseignez-vous sur le critère, nombreux exemples sur le forum.

La plage du critère est composée de 2 cellules, d'où Resize(2).

La plage filtrée est copiée grâce à l'argument xlFilterCopy.

Avec le nouveau critère voyez ce fichier (2) :

    .Cells(2, .Columns.Count + 2) = "=COUNTIF(L2:M2,""*MJE*"")*(Q2<100)" 'critère

A+

 

[MJE]

Merci !