Copier une valeur si valeur trouvée

titiborregan5

XLDnaute Accro
Bonjour à tous,
j'ai une question toute bête mais pour laquelle je n'ai pas trouvé la solution sur le forum :s

J'ai une référence en A3 : Février on va dire
Une valeur qui lui correspond en B3: 20 par exemple

Dans G3:G15 j'ai les mois : Janvier - Février - Mars - etc...

je souhaiterai que si la macro trouve A3 dans G3:G15, il me copie la valeur dans la colonne H (décalage à droite de 1) trouvée en B3.

Merci de vos lumières parce que là je bloque sur qqch de tout simple!!!


Bonne journée

Thibault
 

Catrice

XLDnaute Barbatruc
Re : Copier une valeur si valeur trouvée

Bonsoir,

Essaie cette version qui normalement doit copier les données pour les semaines à cheval sur un mois ou sur une année.

Code:
Sub Planning2()
MaFeuille = "mise a jour planning" 'Feuille du planning
MaPlage = "C19:I19" 'Plage du planning (les dates)
NbLig = 11 'Nombre de lignes (nb de noms à traiter)
MesCrit = Array("21h15/6h15", "tn", "REPOS", "rp", "CONGES", "cp") 'Criteres à reporter (par paires)
'-------------------Message---------------------
If MsgBox("Attention le planning du " & Sheets(MaFeuille).Range("C7") & " va etre mis à jour." & Chr(10) & "Etes-vous sûr ?", vbOKCancel) = 2 Then Exit Sub
'------------------------------------------------
For Each X In Sheets(MaFeuille).Range(MaPlage)
    Marqueur = 0
    Onglet = "ABS " & Format(X.Value, "yyyy")
    For Each Z In Sheets 'Verifie l'existence de l'onglet destination
        If Z.Name = Onglet Then Marqueur = 1
    Next
    If Marqueur = 0 Then Exit Sub
    With Sheets(Onglet)
        Lig1 = Application.Match(DateSerial(Year(X.Value), Month(X.Value), 1) * 1, .Range("A1:A400"), 0) + 1 'Ligne où se trouve la date (mois) recherchée
        Col1 = Application.Match(X.Value2, .Cells(Lig1, 1).Resize(1, 32), 0) 'Colonne où se trouve la date (jour) recherché
        .Cells(Lig1 + 1, Col1).Resize(NbLig, 1).Value = IIf(Weekday(X.Value, 2) > 5, "rp", "cp")
        For Each Y In X.Offset(1, 0).Resize(NbLig, 1)
            LeNom = Sheets(MaFeuille).Cells(Y.Row, Sheets(MaFeuille).Range(MaPlage).Column + 7).Value 'Nom sur la ligne en cours
            Lig2 = Application.Match(LeNom, .Cells(Lig1 + 1, 1).Resize(NbLig, 1), 0) 'offset du nom dans le mois recherché
            MonCrit = Application.Match(Y.Value, MesCrit, 0)
            If Not IsError(Lig2) Then
                If IsError(MonCrit) Then
                    .Cells(Lig1 + Lig2, Col1).Value = "tj"
                Else
                    .Cells(Lig1 + Lig2, Col1).Value = MesCrit(MonCrit)
                End If
            End If
        Next
    End With
Next
End Sub
 

justine62000

XLDnaute Occasionnel
Re : Copier une valeur si valeur trouvée

:)bonjour catrice oui ca fonctionne
c'est super
je te remerci beaucoup de ton aide trés precieuse
une derniere chose les noms remplacement 1,remplacement 2 et remplacement 3 ne travaille que quand une personne du planning est en congés ou rtt comment faire pour qu'il n'affiche pas cp pour les personnes de remplacements(1.2 et 3)
je croyais quand modifiant le nombre de nom a traité le probleme serait resolu mais non car lorsque le personne de remplacement travaille il n'afficher pas tj ou tn comme prevu

as tu une idée

justine:):)
 

Catrice

XLDnaute Barbatruc
Re : Copier une valeur si valeur trouvée

Bonjour,

Je n'ai rien compris concernant le fontionnement de remplacement 1,2,3 ..

Peux tu préciser ?
Pour le moment, ils ne sont pas traités.
Remplacement 1,2 ou 3 peuvent apparaitre dans "mise a jour planning" ?
 

justine62000

XLDnaute Occasionnel
Re : Copier une valeur si valeur trouvée

bonjour catrice
dans mon fichier j'ai remis comme a l'origine donc pour le personnel remplacement ils sont traités
"NbLig = 11 'Nombre de lignes (nb de noms à traiter)" j'ai remplacer 11 par 14
mon but:
chaque personne de remplacement ne travaille que lorsqu'une personne du planning est en cp ou rtt sinon aucune personne de remplacement ne travaille donc si personne de remplacement ne travaille pas il ne faut pas remplir la feuille gestion absence 2009 pour ces personnes'remplacement 1,remplacement2 et remplacement3)
il faut donc trouver une formule sans employé le nom remplacement 1 (qui est un nom fictif pour le moment il sera remplacer par la suite) pour que si il ne figure pas sur le planning c'est a dire mise a jour planning plage j20:j30 ne pas remplir la feuille gestion absence(c'est a dite tj,tn,cp) pare contre si son nom figure dans cette plage j20:j30 de la feuille mise a jour planning alors remplir la feuille gestion absence selon les criteresdefinit dans le code du message 77 qui fonctionne tres bien


est ce un peu plus claire
ps etant donné que le nom remplacement 1 sera remplacé par le nom reelle de la persone a l'ouverture de cette structure c'est a dire novembre 2010
si tu prefere des qu'une personne prend des cp ou rtt ou fait appel a une personne exterieur pour le remplacement que l'on a deja prevu sur le planning mais que l'on ne connais pas encore le nom
en bref il ne faut doit pas avoir de cp pour les personnes se trouvant sur les lignes 12,13 et 14
justine
 

Catrice

XLDnaute Barbatruc
Re : Copier une valeur si valeur trouvée

Bonsoir,

Je crois que j'ai compris.
En colonne J de "mise a jour planning" tu vas saisir un remplaçant, toto remplace alain par exemple. En colonne A de "ABS aaaa" toto apparaitra, il faudra que la mise à jour mette sur toto le planning de alain et que sur alain il y ait cp et rp.

si c'est ça, teste le code suivant :

Code:
Sub Planning2()
MaFeuille = "mise a jour planning" 'Feuille du planning
MaPlage = "C19:I19" 'Plage du planning (les dates)
NbLig1 = 11 'Nombre de lignes (nb de noms à traiter)
NbLig2 = 14 'Nombre de lignes total (y compris les remplaçants)
MesCrit = Array("21h15/6h15", "tn", "REPOS", "rp", "CONGES", "cp") 'Criteres à reporter (par paires)
'-------------------Message---------------------
If MsgBox("Attention le planning du " & Sheets(MaFeuille).Range("C7") & " va etre mis à jour." & Chr(10) & "Etes-vous sûr ?", vbOKCancel) = 2 Then Exit Sub
'------------------------------------------------
For Each X In Sheets(MaFeuille).Range(MaPlage)
    Marqueur = 0
    Onglet = "ABS " & Format(X.Value, "yyyy")
    For Each Z In Sheets 'Verifie l'existence de l'onglet destination
        If Z.Name = Onglet Then Marqueur = 1
    Next
    If Marqueur = 0 Then Exit Sub
    With Sheets(Onglet)
        Lig1 = Application.Match(DateSerial(Year(X.Value), Month(X.Value), 1) * 1, .Range("A1:A400"), 0) + 1 'Ligne où se trouve la date (mois) recherchée
        Col1 = Application.Match(X.Value2, .Cells(Lig1, 1).Resize(1, 32), 0) 'Colonne où se trouve la date (jour) recherché
        .Cells(Lig1 + 1, Col1).Resize(NbLig1, 1).Value = IIf(Weekday(X.Value, 2) > 5, "rp", "cp")
        For Each Y In X.Offset(1, 0).Resize(NbLig1, 1)
            LeNom = Sheets(MaFeuille).Cells(Y.Row, Sheets(MaFeuille).Range(MaPlage).Column + 7).Value 'Nom sur la ligne en cours
            Lig2 = Application.Match(LeNom, .Cells(Lig1 + 1, 1).Resize(NbLig2, 1), 0) 'offset du nom dans le mois recherché
            MonCrit = Application.Match(Y.Value, MesCrit, 0)
            If Not IsError(Lig2) Then
                If IsError(MonCrit) Then
                    .Cells(Lig1 + Lig2, Col1).Value = "tj"
                Else
                    .Cells(Lig1 + Lig2, Col1).Value = MesCrit(MonCrit)
                End If
            End If
        Next
    End With
Next
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 211
Messages
2 086 293
Membres
103 171
dernier inscrit
clemm