Copier des lignes avec certaines valeurs d'un onglet à l'autre

Neruda

XLDnaute Nouveau
Bonjour,

J'ai sur un onglet une liste de critères.
Le numéro du critère en A1
Le texte du critère en B1
Le statut du critère en C1 (il peut être "C" ou "NC")

Comment récupérer seulement ceux qui sont NC,
copier dans un autre onglet seulement les cellules A et B de chaque critère NC,
(en insérant le nombre de lignes nécessaires) ?

Si quelqu'un peut m'aider svp

Merci
 

Neruda

XLDnaute Nouveau
J'ai refait un nouveau fichier à partir du fichier original vierge,
J'ai mis la dernière version du code de la macro qui remontait bien les éléments où il fallait mais dans l'ordre inverse.
Dans un deuxième temps je voulais aller chercher dans toutes les pages (de P01 à P20) dans toutes les colonnes H le texte de chaque cellule rencontré et le copier dans la partie déclaration en m'aidant de ce code. Mais je vois déjà plusieurs difficultés.
  • la recherche doit se faire sur plusieurs feuilles
  • il peut y avoir 20 feuilles à fouiller maxi, mais on peut en supprimer si moins de pages, donc il peut y en avoir moins
  • il sera difficile d'indiquer où les ajouter sur la feuille déclaration car l'emplacement initial va être modifié après l'ajout des critères
Merci encore pour l'aide, j'ai LibreOffice Calc et pas Excel, je ne sais pas si ça a un impact, j'ai d'ailleurs dû le zipper pour que le format de fichier .ods soit accepté
 
Dernière édition:

Neruda

XLDnaute Nouveau
D'ailleurs ma condition pour afficher un mot selon le niveau ne marche plus, ou n'a jamais marché sur la feuille déclaration.
si 100 % alors Conformité, si >ou = à 50 % alors Conformité partielle, si < à 50 % alors Non-conformité
Merci
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re bonjour,
Un essai en PJ.
Je ne suis pas sur que XL et LibreOffice soit 100% compatible. En tout cas votre fichier ods est arrivé sans macro.
Dans la PJ on insère la date d'audit et on rapatrie toutes les non conformités de toutes les feuilles s'appelant Pxx.
Je ne supprime aucune ligne dans les feuilles.
Voilà, vous avez un squelette nécessaire et suffisant pout fignoler à votre goût.
Pour le post #19, rien compris ... donc non traité.
Il y a suffisament de commentaires pour que vous puissiez facilement modifier le code.
VB:
Sub Audit()
Dim Sh As Worksheet, LigneInsertion As Integer, DerLig As Integer, N As Integer
' Figer écran
Application.ScreenUpdating = False
' N est le nombre de non conformités trouvées
N = 0
' Recherche où se trouve "ÉTABLISSEMENT DE CETTE DÉCLARATION D’ACCESSIBILITÉ" dans la page Declaration.
LigneInsertion = 1 + Application.Match("ÉTABLISSEMENT DE CETTE DÉCLARATION D’ACCESSIBILITÉ*", Sheets("Declaration").Range("A:A"), 0)
' Insertion de la date d'audit
Sheets("Declaration").Range("A" & LigneInsertion) = "Cette déclaration a été établie le " & Format(Date, "dddd dd mmmm yyyy")
' Recherche où se trouve "Non-conformité" dans la page Declaration. C'est la ligne où inserer.
LigneInsertion = 1 + Application.Match("Non-conformité", Sheets("Declaration").Range("A:A"), 0)
' On parcourt toutes les feuilles
For Each Sh In ActiveWorkbook.Sheets
    If Len(Sh.Name) = 3 And Left(Sh.Name, 1) = "P" Then         ' Ne concerne que les feuilles commençant par P et ayant 3 caractères ( type P01 )
        DerLig = Sheets(Sh.Name).Range("D65000").End(xlUp).Row  ' Nombre de lignes de la feuille Pxx
        For Ligne = 4 To DerLig                                 ' Pour toutes les lignes de la feuille Pxx
            If Sheets(Sh.Name).Cells(Ligne, "D") = "NC" Then    ' Si NC alors
                With Sheets("Declaration")                      ' Inserer lignes et ajouter données
                    .Rows(LigneInsertion).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion ligne
                    .Cells(LigneInsertion, 1) = Sheets(Sh.Name).Cells(Ligne, 2)  ' N°
                    .Cells(LigneInsertion, 2) = Sheets(Sh.Name).Cells(Ligne, 3)  ' Critère
                    LigneInsertion = LigneInsertion + 1         ' Incrément index pour la prochaine insertion
                    N = N + 1                                   ' Une non conformité de plus
                End With
            End If
        Next Ligne
   End If
Next Sh
' Sortie avec message
Application.ScreenUpdating = True
MsgBox " Nombre de non conformité trouvées : " & N
End Sub
 

Pièces jointes

  • A-Test-Macro.xlsm
    359.4 KB · Affichages: 19

Neruda

XLDnaute Nouveau
Bonjour,

Merci pour le fichier, je l'ai enlevé du message précédent car j'avais oublié d'enlever un vrai nom dedans,
si vous pouviez enlever aussi le votre svp,
en fait je devais prendre seulement les critères NC de la feuille Critères et copier tous les textes de la colonne H dont une ligne avait D comme valeur de la colonne "E",
je vais essayer d'adapter ça à partir de votre code (et remettrai le fichier sans le vrai nom)

Merci
 

Neruda

XLDnaute Nouveau
Désolé, c'est que je m'étais mal expliqué, mais c'est parfait,
J'ai d'un côté ce qu'il me faut pour récupérer les critères depuis la feuilles critères
et j'ai votre nouveau code pour parcourir toutes les feuilles avec un nom de type PXX,
je vais adapter ce dernier code pour faire ce que j'ai mal expliqué et ensuite j'essaierai d'ajouter le précédent, quitte à faire une deuxième macro si je n'arrive pas à les mettre dans la même,
Merci encore
 

Neruda

XLDnaute Nouveau
C'est parfait, le code marche bien, je n'avais jamais vu de Macro avant la vôtre mais c'est très efficace.
J'ai bien pu l'adapter pour récupérer mes critères D sur toutes les feuilles de type Pxx,
et pour lister tous les critères NC de la feuille Critères dans le bon ordre,
merci beaucoup pour votre aide, impossible sinon.
Et je vais garder précieusement ce code car il va me permettre pas mal de choses dans d'autres contextes.
Merci encore

VB:
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Sub Audit()
Dim Sh As Worksheet, LigneInsertion As Integer, DerLig As Integer, N As Integer
' Figer écran
Application.ScreenUpdating = False
' N est le nombre de non conformités trouvées
N = 0
' Recherche où se trouve "ÉTABLISSEMENT DE CETTE DÉCLARATION D’ACCESSIBILITÉ" dans la page Declaration.
LigneInsertion = 1 + Application.Match("ÉTABLISSEMENT DE CETTE DÉCLARATION D’ACCESSIBILITÉ*", Sheets("Declaration").Range("A:A"), 0)
' Insertion de la date d'audit
Sheets("Declaration").Range("A" & LigneInsertion) = "Cette déclaration a été établie le " & Format(Date, "dddd dd mmmm yyyy")
' Recherche où se trouve "Non-conformité" dans la page Declaration. C'est la ligne où inserer.
LigneInsertion = 1 + Application.Match("Non-conformité", Sheets("Declaration").Range("A:A"), 0)
' On ajoute les critères NC de la feuille Critères dans la feuille déclaration
DerLig = Sheets("Critères").Range("D65000").End(xlUp).Row
For Ligne = 2 To DerLig
    If Sheets("Critères").Cells(Ligne, "D") = "NC" Then
        With Sheets("Declaration")
            .Rows(LigneInsertion).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion ligne
            .Cells(LigneInsertion, 1) = Sheets("Critères").Cells(Ligne, 2)  ' N°
            .Cells(LigneInsertion, 2) = Sheets("Critères").Cells(Ligne, 3)  ' Critère
            LigneInsertion = LigneInsertion + 1         ' Incrément index pour la prochaine insertion
        End With
    End If
Next Ligne
' Recherche où se trouve "Contenus non soumis à l’obligation d’accessibilité" dans la page Declaration. C'est la ligne où inserer.
LigneInsertion = 1 + Application.Match("Contenus non soumis à l’obligation d’accessibilité", Sheets("Declaration").Range("A:A"), 0)
' On parcourt toutes les feuilles
For Each Sh In ActiveWorkbook.Sheets
    If Len(Sh.Name) = 3 And Left(Sh.Name, 1) = "P" Then         ' Ne concerne que les feuilles commençant par P et ayant 3 caractères ( type P01 )
        DerLig = Sheets(Sh.Name).Range("D65000").End(xlUp).Row  ' Nombre de lignes de la feuille Pxx
        For Ligne = 4 To DerLig                                 ' Pour toutes les lignes de la feuille Pxx
            If Sheets(Sh.Name).Cells(Ligne, "E") = "D" Then     ' Si D alors
                With Sheets("Declaration")                      ' Inserer lignes et ajouter données
                    .Rows(LigneInsertion).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove ' Insertion ligne
                    .Cells(LigneInsertion, 1) = Sheets(Sh.Name).Cells(Ligne, 8)  ' Texte de la colonne H de toutes les lignes qui contiennent la valeur D en colonne E
                    LigneInsertion = LigneInsertion + 1         ' Incrément index pour la prochaine insertion
                    N = N + 1                                   ' Une non conformité de plus
                End With
            End If
        Next Ligne
   End If
Next Sh
' Sortie avec message
Application.ScreenUpdating = True
MsgBox " Nombre de non conformité trouvées : " & N
End Sub
 

Discussions similaires

Réponses
5
Affichages
335
Compte Supprimé 979
C

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 837
dernier inscrit
Ugo