Déplacement d'une valeur en fonction d'une réponse prédefinie

Bonjour

Dans le "fichier pour aide" en annexe, la colonne AE des feuilles 1 & 2 contient une liste déroulante "Oui,Non"

Je souhaite que lorsqu'on choisi "oui" dans cette colonne, la feuille 3 s'ouvre et la référence reprise en colonne "C" des feuilles 1 ou 2 s'inscrive dans la colonne G de la feuille 3 sur la première ligne disponnible

D'avance merci pour votre aide

Bonjour et bienvenue

En supposant que c'est votre bon fichier, faites ceci

- Allez dans l'éditeur VBA (à gauche vous verrez en principe une fenêtre VBA Project)
- Double clic sur THISWORKBOOK
- collez le code ci-dessous dans la fenêtre

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim dlg As Integer

If Sh.CodeName = "Feuil3" Or Sh.CodeName = "Feuil4" Then Exit Sub
    If Not Intersect(Target, Sh.Range("AE2:AE" & Sh.Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
        If UCase(Target) = "OUI" Then
            dlg = Feuil3.Range("G" & Rows.Count).End(xlUp).Row + 1
            Feuil3.Cells(dlg, "G") = Range("C" & Target.Row).Value
        End If
    End If
End Sub

- enregistrez votre fichier au format XLSM pour accepter les macros

Faites un test en ajoutant le Oui dans la colonne AE.

Rem : Le code ne traite pas les erreurs ou le doublon. exemple vous mettez un oui au lieu d'un non. Dès que vous faites le choix de oui, le code enverra la valeur C dans la feuille 3
Si d'autres info à part la colonne C devait être envoyée vers la feuil3 en fonction du oui, je pense que l'outil Power query pourrait être utilisé. Mais voyez d'abord si la proposition suffit à ce que vous demandes

Pensez à cloturer le fil si ok et terminé

Crdlt

Bonjour Dan

Déjà, merci d'avoir pris le temps de me répondre.

J'ai installé la macro comme décrit et cela fonctionne partiellement

En effet,

- si je choisi "non" dans la colonne AE il y a quand même transcription dans la feuille 3

- si je passe de "oui" à "non" il y a nouvelle transcription dans la feuille 3

- si je delete le "oui/non" il n'y a pas effacement dans la feuille 3

Et enfin, j'avais oublié de le préciser, il ne faut pas qu'il y ait pas plusieur

transcription de la meme reference

D'avance merci pour ton aide

Bien cordialement

Alfii

Re

- si je choisi "non" dans la colonne AE il y a quand même transcription dans la feuille 3
- si je passe de "oui" à "non" il y a nouvelle transcription dans la feuille 3

Heu non ce n'est pas possible. Effacez la colonne G dans la feuille 3 puis faites vos choix de Oui.
Si vous voyez deux fois la même chose c'est que vous avez choisis deux fois le oui

- si je delete le "oui/non" il n'y a pas effacement dans la feuille 3

Exact mais vous n'avez pas précisé dans votre demande. Donc le code est à amender

Bonjour Dan

Effectivementn je n'avais pas précisé, toutes mes excuses.

Auriez vous la gentilesse de modifier le code afin qu'il réponde à mes besoins (et souhaits ) svp?

Pour être certain de ne rien oublier, je récapitule:

- Si je choisi "oui" dans la feuille 1 ou 2 , la référence s'incrit en feuille 3

- Si je choisi "non" rien ne se passe

- Si je change le "oui" en "non" la transcription s'annule et la référence s'efface de la feuille 3

- Si j'efface "oui" ou "non" la transcription s'annule et la référence s'efface de de la feuille 3

- La référence est unique et ne doit jamais se retrouver plusieures fois en feuille 3

D'avance un tout grand merci

Bien cordialement

Alfii

Re

Merci des précisions. Là on peut mieux comprendre

Par contre je suppose qu'en cas de Non ou de cellule vide, on supprime bien la ligne entière dans le feuille 3 ou c'est uniquement la référence en colonne G qu'il faut supprimer ?

Merci pour cette finesse a laquelle je n'avais pas pensé

Je confirme qu'on suprime bien la ligne entière

Bien cordialement

Alfii

Je confirme qu'on suprime bien la ligne entière

Alors remplacez tout le code par celui ci-dessous

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim dlg As Integer, lig As Integer

If Target.Count > 1 Then Exit Sub
If Sh.CodeName = "Feuil3" Or Sh.CodeName = "Feuil4" Then Exit Sub

If Not Intersect(Target, Sh.Range("AE2:AE" & Sh.Range("C" & Rows.Count).End(xlUp).Row)) Is Nothing Then
    On Error Resume Next
    lig = WorksheetFunction.Match(ActiveSheet.Range("C" & Target.Row), Feuil3.Columns("G"), 0)
    On Error GoTo 0

    Select Case UCase(Target)
        Case Is = "OUI"
            If lig > 0 Then Exit Sub
            On Error GoTo 0

            dlg = Feuil3.Range("G" & Rows.Count).End(xlUp).Row + 1
            Feuil3.Cells(dlg, "G") = Range("C" & Target.Row).Value

        Case Is = "NON", ""
            If lig = 0 Then Exit Sub
            Feuil3.Rows(lig).Delete

    End Select
End If
End Sub

Si ok pensez à cloturer le fil

Crdlt

PS: Bonjour à Wavre !

1000 Merci Dan, la macro est 100% opérationnelle.
Et Wavre te salue également