Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

M

MJE

XLDnaute Nouveau
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.
 

Pièces jointes

  • OPL_TEST.xlsm
    45.6 KB · Affichages: 10
Trier par date Trier par votes

job75

XLDnaute Barbatruc
Bonjour MJE, bienvenue sur XLD,

Le code de la feuille "MJE" :
VB: 
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+
 

Pièces jointes

  • OPL_TEST(1).xlsm
    43.6 KB · Affichages: 6
Vote positif 0 Vote négatif
M

MJE

XLDnaute Nouveau
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:
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 :

VB: 
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
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
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) :
VB: 
    .Cells(2, .Columns.Count + 2) = "=COUNTIF(L2:M2,""*MJE*"")*(Q2<100)" 'critère
A+
 

Pièces jointes

  • OPL_TEST(2).xlsm
    43.9 KB · Affichages: 5
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

R
  • Question
XL 2010 Copier des lignes de données de plusieurs feuilles dans une seule
Réponses
5
Affichages
468
sylvanu
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
443
Nel'
N
C
  • Résolu(e)
Autres Code VBA pour recherche et copie/coller de ligne avec mot clé.
Réponses
12
Affichages
520
Corentin26270
C
S
  • Résolu(e)
XL 2016 copier des données d'une feuille à une autre selon critères et protection de la feuille 1
Réponses
6
Affichages
412
steph_29120
S
N
  • Résolu(e)
Microsoft 365 Code erreur dans code Vba
Réponses
14
Affichages
356
TooFatBoy
M
  • Question
XL 2021 Rechercher dans une matrice le texte d'une cellule et copier les 10 lignes situées en dessous de ce texte retrouvé
Réponses
2
Affichages
364
JHA
J
O
  • Question
XL 2019 Code VBA pour automatiser la programmation des rotations des ouvriers qui travaillent à temps partiel et se relaient par période de temps constante.
2 3
Réponses
35
Affichages
1 K
olivier1984
O
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
673
Pac41240
P
  • Question
Microsoft 365 VBA : copier / coller d'un onglet à l'autre en fonction d'une valeur
Réponses
8
Affichages
547
Lisette
H
  • Résolu(e)
Microsoft 365 Archivage automatique sous condition (Macro)
Réponses
2
Affichages
505
HugoLaChips
H
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…