XL 2016 Aide code VBA

[medsoft313]

Je n'arrive pas à adapter ce code pour vérifier la colonne D de la Feuille 3 si elle contient la valeur "Ag" alors afficher les valeurs
de la feuille 3 dans la feuille1. et si la valeur est "Ap" alors afficher les valeurs de la feuille 3 dans la feuille 2 et si la valeur n'est ni "Ag" ni "Ap", aucune action n'est entreprise ou un message d'erreur.

Sub Test()

ActiveSheet.Unprotect "123"
Sheets("Feuil1").Unprotect "123"
Sheets("Feuil2").Unprotect "123"

If Not IsEmpty(Range("G2").Value) Then
Dim ws As Worksheet
Set ws = Sheets("Feuil3")
Dim colD As Range
Set colD = ws.Range("D17400")
Dim hasAg As Boolean
Dim hasAp As Boolean

For Each cell In colD
If cell.Value = "Ag" Then
hasAg = True
Sheets("Feuil1").Range("J12").Font.Color = vbBlack
Sheets("Feuil1").Range("J12").Value = Application.Evaluate("IFERROR(VLOOKUP('" & ws.Name & "'!G2,'" & ws.Name & "'!A17:S400,1,FALSE),"""")")
Sheets("Feuil1").Range("F14").Value = Application.Evaluate("IFERROR(VLOOKUP('" & ws.Name & "'!G2,'" & ws.Name & "'!A17:S400,5,FALSE),"""")")
Sheets("Feuil1").Range("E20").Value = Application.Evaluate("IFERROR(VLOOKUP('" & ws.Name & "'!G2,'" & ws.Name & "'!A17:S400,2,FALSE),"""")")

Sheets("Feuil1").Shapes("Groupe 16").Visible = False
Sheets("Feuil1").Select
Exit For ' Sortir de la boucle si le mot est trouvé
ElseIf cell.Value = "Ap" Then
hasAppro = True
Sheets("Feuil2").Range("J12").Value = Application.Evaluate("IFERROR(VLOOKUP('" & ws.Name & "'!G2,'" & ws.Name & "'!A17:S400,1,FALSE),"""")")
Sheets("Feuil2").Range("F14").Value = Application.Evaluate("IFERROR(VLOOKUP('" & ws.Name & "'!G2,'" & ws.Name & "'!A17:S400,5,FALSE),"""")")
Sheets("Feuil2").Range("J17").Value = Application.Evaluate("IFERROR(VLOOKUP('" & ws.Name & "'!G2,'" & ws.Name & "'!A17:S400,10,FALSE),"""")")
Sheets("Feuil2").Select
Exit For ' Sortir de la boucle si le mot est trouvé
End If
Next cell

If Not hasAg And Not hasAp Then
MsgBox "La colonne D de la plage de cellules spécifiée ne contient ni le mot Ag, ni le mot Ap.", vbCritical, "Erreur"
End If

End If

ActiveSheet.Protect "123", True, True, True
Sheets("Feuil1").Protect "123", True, True, True
Sheets("Feuil2").Protect "123", True, True, True

End Sub

 

[vgendron]

BONJOUR !

 

[sylvanu]

Bonjour Vgendron, Medsoft,
Et par la même occasion :
1- Pour le code utilisez les balises </> c'est plus clair ( à droite de l'icone GIF )
2- Fournissez un petit fichier test, ce sera plus simple.
3- Relisez la bible suivant Saint David ( Lien )

Lorsqu’on rentre sur un fil, comme dans la vie de tous les jours, on est poli en disant « Bonjour ».

 

[medsoft313]

Tout d'abord je vous présente mais s'excuse et bonjour à tous

Je n'arrive pas S.V.P à adapter ce code pour vérifier la colonne D de la feuille 3 si elle contient la valeur "Ag" alors afficher les valeurs de la feuille 3 dans la feuille 1.
Et si la valeur est "Ap" alors afficher les valeurs de la feuille 3 dans la feuille 2 et si la valeur n'est ni "Ag" ni "Ap", aucune action n'est entreprise ou un message d'erreur. pour plus de détails ci-joints un fichier Excel pour test.

Merci d'avance.

 

[vgendron]

Avec ceci

ActiveSheet.Unprotect "123"
Sheets("Feuil1").Unprotect "123"
Sheets("Feuil2").Unprotect "123"
Valeur = Range("G2")
With Sheets("Feuil3").ListObjects(1)
    Set trouve = .ListColumns("Numero").Range.Find(Valeur, LookIn:=xlValues)
    If trouve Is Nothing Then Exit Sub
    
    ligne = trouve.Row - .Range.Row
    Col4 = .DataBodyRange(ligne, 4)
    
    Select Case UCase(Col4)
        Case "AG"
            Set wsDest = Sheets("Feuil1")
    
        Case "AP"

            Set wsDest = Sheets("Feuil2")
    End Select
    
   wsDest.Range("J12") = .DataBodyRange(ligne, 1)
   wsDest.Range("F14") = .DataBodyRange(ligne, 2)
    wsDest.Range("E20") = .DataBodyRange(ligne, 3)
    
        
End With

ActiveSheet.Protect "123", True, True, True
Sheets("Feuil1").Protect "123", True, True, True
Sheets("Feuil2").Protect "123", True, True, True
End Sub

 

[medsoft313]

Avec ceci

ActiveSheet.Unprotect "123"
Sheets("Feuil1").Unprotect "123"
Sheets("Feuil2").Unprotect "123"
Valeur = Range("G2")
With Sheets("Feuil3").ListObjects(1)
    Set trouve = .ListColumns("Numero").Range.Find(Valeur, LookIn:=xlValues)
    If trouve Is Nothing Then Exit Sub
   
    ligne = trouve.Row - .Range.Row
    Col4 = .DataBodyRange(ligne, 4)
   
    Select Case UCase(Col4)
        Case "AG"
            Set wsDest = Sheets("Feuil1")
   
        Case "AP"

            Set wsDest = Sheets("Feuil2")
    End Select
   
   wsDest.Range("J12") = .DataBodyRange(ligne, 1)
   wsDest.Range("F14") = .DataBodyRange(ligne, 2)
    wsDest.Range("E20") = .DataBodyRange(ligne, 3)
   
       
End With

ActiveSheet.Protect "123", True, True, True
Sheets("Feuil1").Protect "123", True, True, True
Sheets("Feuil2").Protect "123", True, True, True
End Sub

Merci cher ami ça marche mais pas a tous les coups j'arrive pas comprendre

 

[vgendron]

bah, déjà. je ne comprend pas pourquoi le code active parfois la feuille....alors qu'il n'y a aucun activate ....

sans doute la protection??

 

[medsoft313]

M

bah, déjà. je ne comprend pas pourquoi le code active parfois la feuille....alors qu'il n'y a aucun activate ....

sans doute la protection??

Merci infiniment