XL 2016 Aide code VBA

medsoft313 · 15 Mars 2023

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 · 15 Mars 2023

BONJOUR !

sylvanu · 15 Mars 2023

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 · 15 Mars 2023

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 · 15 Mars 2023

Avec ceci

VB:

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 · 15 Mars 2023

vgendron à dit:

Avec ceci

VB:

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 · 15 Mars 2023

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 · 15 Mars 2023

M

vgendron à dit:
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

XL 2016 Aide code VBA

medsoft313

XLDnaute Nouveau

vgendron

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

medsoft313

XLDnaute Nouveau

Pièces jointes

vgendron

XLDnaute Barbatruc

medsoft313

XLDnaute Nouveau

Pièces jointes

vgendron

XLDnaute Barbatruc

medsoft313

XLDnaute Nouveau

Discussions similaires