Microsoft 365 Comment copier 2 colonnes d'une ligne en fonction d'un mot dans une autre feuille

sylvanu à dit:

Bonjour Lilicorail,
D'après ce que j'ai compris, votre solution ne me semble pas correcte. Je m'explique :
Imaginons l'item 1.1.1 avec NS en A1, on le mémorise dans Plan d'action.
S'ensuivra un écart constaté puis une action proposée ( d'ailleurs à laquelle devrait suivre un suivi de l'action ainsi qu'une date )
Puis ensuite on trouve pour le même item NS en A2, vous demandez donc de remplacer dans Plan d'action cet item par le nouveau. Dans ce cas il faut effacer l'écart et l'action qui n'ont plus rien à voir. Donc vous perdez toute traçabilité. Ce qui est ballot pour un audit.
La solution adoptée pour tout bilan d'audit ( tout du moins, tous ceux que je connais ) est d'ajouter une colonne Statut ( En cours, Clos ) dans le plan d'action et d'enregistrer à la suite tout nouveau item.
De cette façon vous tracez l'ensemble des actions effectués sur l'item. Un filtrage sur Statut vous permet d'afficher que les actions En cours.
Par ex :
Regarde la pièce jointe 1136343
Mais cela ne correspond plus à la requête initiale.
Votre avis ?

Cliquez pour agrandir...

sylvanu à dit:

Bonjour,
Un essai en PJ avec dans la feuille Grille audit la macro événementielle suivante :

VB:

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("C1:E200")) Is Nothing Then
        On Error GoTo Fin:
        Application.ScreenUpdating = False
        Dim N%
        If Cells(Target.Row, "B") = "" Then Exit Sub
        If Target <> "M" And Target <> "NS" Then Exit Sub
        With Sheets("Plan d'action")
            N = .[Tableau2].Rows.Count
            If N > 1 Then .[Tableau2].ListObject.ListRows.Add
            .[Tableau2[N° item]].Item(N) = Cells(Target.Row, "A")
            .[Tableau2[Points contrôlés]].Item(N) = Cells(Target.Row, "B")
        End With
    End If
Fin:
Application.ScreenUpdating = True
End Sub

Dès qu'on détecte un M ou un NS en colonnes CDE alors on enregistre dans le plan d'action le N° item et les Points contrôlés.

Cliquez pour agrandir...

sylvanu à dit:

Bonjour,
Un essai en PJ avec dans la feuille Grille audit la macro événementielle suivante :

VB:

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("C1:E200")) Is Nothing Then
        On Error GoTo Fin:
        Application.ScreenUpdating = False
        Dim N%
        If Cells(Target.Row, "B") = "" Then Exit Sub
        If Target <> "M" And Target <> "NS" Then Exit Sub
        With Sheets("Plan d'action")
            N = .[Tableau2].Rows.Count
            If N > 1 Then .[Tableau2].ListObject.ListRows.Add
            .[Tableau2[N° item]].Item(N) = Cells(Target.Row, "A")
            .[Tableau2[Points contrôlés]].Item(N) = Cells(Target.Row, "B")
        End With
    End If
Fin:
Application.ScreenUpdating = True
End Sub

Dès qu'on détecte un M ou un NS en colonnes CDE alors on enregistre dans le plan d'action le N° item et les Points contrôlés.

Cliquez pour agrandir...

sylvanu à dit:

Bonjour Lilicorail,
A l'origine le code était plus simple mais laissé la première ligne vide. D'où la modif sauvage ... non testée. Mea culpa.
Par contre votre modif laisse aussi la première ligne vide. Pour résoudre le problème (après l'avoir testée )

VB:

        With Sheets("Plan d'action")
            N = .[Tableau2].Rows.Count   ' N° ligne d'écriture
            If N >= 1 And .[Tableau2[N° item]].Item(N) <> "" Then
                .[Tableau2].ListObject.ListRows.Add
                N = N + 1
            End If
            .[Tableau2[N° item]].Item(N) = Cells(Target.Row, "A")
            .[Tableau2[Points contrôlés]].Item(N) = Cells(Target.Row, "B")
        End With

Voir PJ.

Cliquez pour agrandir...

sylvanu à dit:

Bonjour Lilicorail,
A l'origine le code était plus simple mais laissé la première ligne vide. D'où la modif sauvage ... non testée. Mea culpa.
Par contre votre modif laisse aussi la première ligne vide. Pour résoudre le problème (après l'avoir testée )

VB:

        With Sheets("Plan d'action")
            N = .[Tableau2].Rows.Count   ' N° ligne d'écriture
            If N >= 1 And .[Tableau2[N° item]].Item(N) <> "" Then
                .[Tableau2].ListObject.ListRows.Add
                N = N + 1
            End If
            .[Tableau2[N° item]].Item(N) = Cells(Target.Row, "A")
            .[Tableau2[Points contrôlés]].Item(N) = Cells(Target.Row, "B")
        End With

Voir PJ.

Cliquez pour agrandir...

sylvanu à dit:

Re, et que doit on copier dans la feuille "Non évalué". Vous ne l'avez pas précisé.
Je suppose que ce n'est pas la même chose que dans Plan d'action.

Cliquez pour agrandir...