Microsoft 365 formule selon données

[FCMLE44]

Bonjour
Lorsque je sélectionne la donnée souhaitée en cellule B1 de la feuille "Sélection feuille", je souhaite faire la chose suivante
1- Rechercher dans la feuille "Paramètrage" en colonne A, la donnée inscrite en cellule B1 de la feuille "Sélection Feuille"
2- Je récupère les données de cette cellule B1 et les mets automatiquement dans les cellules concernées aux endroits indiquées en feuille "Feuille Calcul Indemnités"
3 - Mettre à jour des cellules selon ces données

Voir mon fichier explicatif en pièce jointe

Quelqu'un peut il m'aider SVP

Merci

 

[Jocelyn]

Bonjour le Forum,
Bonjour FCMLE44,

Un essai en fichier par formule matricielle

Cordialement

 

[FCMLE44]

Bonjour
Lorsque je mets plusieurs lignes en feuille paramétrage correspondant a chaque donnée en colonne A de la feuille paramètre, la feuille feuille calcul indemnités ne se met pas correctement à jour
CF par exemple ICL Ouvriers Travaux Publics

Vous auriez une idée ? J'utilise la formule matricielle fournie par @Jocelyn

 

[sousou]

Bonjour
Une solution macro (ecriture) à tester

 

[FCMLE44]

Merci
Toutefois si je sélectionne ICL Ouvriers Travaux Public en cellule B1 e la feuille "Sélection Feuille", j'obtiens les données A2 à A4 en feuille "feuille calcul indemnités" B51

Je devrais avoir les données des cellules B8 à B12

 

[sousou]

Re
Modifie comme ceci:

Sub ecriture()
critère = Sheets("Sélection Feuille").Range("B1")
With Sheets("Paramètrage")
Set r = .Columns(1).Find(critère)
n = 0
While Not r Is Nothing
MsgBox r.Row
Call remplir(r, n)
n = n + 1
Set r = r.Offset(1, 0).FindNext
Wend
End With
End Sub

Sub remplir(r, n)
With Sheets("Feuille Calcul Indemnités")
lg1 = r.Parent.Cells(1, 2)
lg2 = r.Parent.Cells(1, 3)
lg3 = r.Parent.Cells(1, 4)

.Range(lg1).Offset(n, 0) = r.Offset(0, 1)
.Range(lg2).Offset(n, 0) = r.Offset(0, 2)
If r.Offset(n, 3) <> "" Then phrase = Right(r.Offset(n, 3), Len(r.Offset(n, 3)) - 1) Else phrase = ""
.Range(lg3).Offset(n, 0).FormulaLocal = phrase
End With
End Sub

Sub raz()
With Sheets("Feuille Calcul Indemnités")
.Range("b51:b55").ClearContents
.Range("b57:b62").ClearContents
.Range("e57:e62").ClearContents
End With
End Sub

 

[FCMLE44]

J'ai effacé puis copié ton nouveau code dans le module
Lorsque je sélectionne la feuille rien ne se remplit
Je dois faire un bouton ?

Si tel est le cas ce n'est pas ce que je souhaite, la macro doit se déclencher sur sélection de la cellule B1

 

[sousou]

Comme ceci

 

[FCMLE44]

Merci
Ca a l'air de fonctionner mais je ne souhaite être obligé de cliquer sur ok sur cette pop up.

Il faudrait que cela se passe sans que je valide. Est-ce possible ?

 

[sousou]

oups!

 

[FCMLE44]

Bonjour
Je viens de le remettre sur mon fichier final
Sélection Feuille est remplacé par Salariés
La donnée à sélectionner se trouve en cellule D21 et non pas B1
Sachant que j'avais un worsheet change sur la feuille salariés, j'ai rajouter ton morceau de code comme ceci

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$D$21" Then
        If Target = "" Then Exit Sub
            Call ecriture
    End If
       '****************************************** Masquer/afficher************************
   If Target.Address = "$D$18" Then
        Application.ScreenUpdating = False
        Sheets("Courriers").Range("28:28,232:289").EntireRow.Hidden = False
        Range("20:69").EntireRow.Hidden = False
        Select Case Target.Value
        Case "Démission"
            [20:23,41:69].EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        Case "Fin de contrat Apprentissage", "Fin de contrat Professionnalisation", "Licenciement Faute Grave"
            [20:28,41:69].EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        Case "Décès"
            [20:28,41:69].EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289,28:28").EntireRow.Hidden = True
        Case "Fin de Contrat à Durée Déterminée"
            [20:28,46:69].EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        Case "Licenciement Autres"
            [41:46].EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        Case "Retraite"
            [20:20,22:23,41:46].EntireRow.Hidden = True
        Sheets("Courriers").Range("28:28").EntireRow.Hidden = True
        Case "Rupture Conventionnelle"
            [25:28,41:46].EntireRow.Hidden = True
            Sheets("Courriers").Range("232:289").EntireRow.Hidden = True
        End Select
    End If
    '****************************************** Alerte Retraite************************
    If Target.Address(0, 0) = "D18" And UCase(Range("D18")) = "RETRAITE" Then
        mois = Month(Range("B17")) + 1
        If mois = 13 Then
         mois = 1
        an = Year(Range("B17")) + 1
    Else
        an = Year(Range("B17"))
    End If
        findemois = CDate("01/" & mois & "/" & an) - 1
    If Range("B17") <> findemois Then
    MsgBox ("Attention, un départ en retraite ne doit jamais avoir lieu au début ni même en cours de mois. Uniquement le dernier jour du mois. Merci, par conséquent de modifier la date de sortie en cellule B17. EN CAS D'INFORMATION CONTRAIRE, MERCI DE PRENDRE CONTACT AVEC VOTRE RESPONSABLE DE GROUPE")
      Range("B17") = ""
   End If
End If
End Sub

Feuille Calcul indemnités est remplacé par Indemnités
Paramètrage est remplacé par CCN

J'ai donc modifié le code ainsi

Sub ecriture()
raz
critère = Sheets("Salariés").Range("D21")
With Sheets("CCN")
Set r = .Columns(1).Find(critère)
n = 0
While Not r Is Nothing

Call remplir(r, n)
n = n + 1
Set r = r.Offset(1, 0).FindNext
Wend
End With
End Sub

Sub remplir(r, n)
With Sheets("Indemnités")
lg1 = r.Parent.Cells(1, 2)
lg2 = r.Parent.Cells(1, 3)
lg3 = r.Parent.Cells(1, 4)
'MsgBox r.Row
.Range(lg1).Offset(n, 0) = r.Offset(0, 1)
.Range(lg2).Offset(n, 0) = r.Offset(0, 2)
If r.Offset(n, 3) <> "" Then phrase = Right(r.Offset(n, 3), Len(r.Offset(n, 3)) - 1) Else phrase = ""
.Range(lg3).Offset(n, 0).FormulaLocal = phrase
End With
End Sub

Sub raz()
With Sheets("Indemnités")
.Range("A51:A58") = ""
.Range("A59:A66") = ""
.Range("D59:D66") = ""
End With
End Sub

Lorsque je fais la sélection, j'obtiens ce débogage

Auriez-vous une idée. Cela vient il du Change

 

[sousou]

Pas facile comme cela sans fichier
vérifie à ce moment le contenu de r , n et lg1

 

[FCMLE44]

oupss désolé
je croyais l'avoir mis
a quoi correspondent n r et les
je t envoie le fichier demain si je ne vois pas
merci

 

[FCMLE44]

Pas facile comme cela sans fichier
vérifie à ce moment le contenu de r , n et lg1

Bonjour

Voici le fichier

 

[sousou]

Bonjour
Trois choses:
1/ je n'arrive pas accéder à des données de validation en d21, explique moi la démarche pour y voir quelque chose.
2/ la ligne 1 de la feuille CNN b1, c1 d1 dit contenir la première adresse et non une phrase
b51,b57,e57, si tu souhaites conserver la phrase on trouvera une autre astuce.
3/ la colonne d doit contenir les formule sous la forme "=......, en tout cas c'est le choix que j'avais fait.
à voir si cela t'es possible.
Regarde dans mon fichier ces points.
A suivre