Transfert entre feuille

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

matrix

XLDnaute Occasionnel
Bonjour,

Dans mon fichier excel, Dans la feuille "Horaire Viandes", ce trouve les horaires des employés. Dans la feuille "Remplacement", ce trouve chaque employés avec les préférence de remplacement.

Je voudrais que si une personne est indiqué comme en Vacance dans la feuille "Horaire Viandes" colonne S, qui regarde dans la feuille "Remplacement" en commençant par le premier nom de cette feuille, et assigne les heures de travail au plus vieux en ancienneté.

Exemple: Si Yves, le plus ancien, travail du Mardi au Vendredi à 5H00 mais là, il est en vacance et que Michel lui, est le 2ième en ancienneté, à ce choix, qu'il lui transfert son horaire automatiquement en cliquant sur un bouton VBA.

Si 2 personnes on les même remplaçant, il bog.

Comment faire S.V.P

Merci pour votre aide.
 

Pièces jointes

Dernière édition:
Re : Transfert entre feuille

Re,

Dans le code, "le remplacement de ..." colonne S est recherché en majuscule et donc il ne trouve pas et écrase le premier remplacement.
Modifie le code comme ceci:
Code:
            If Range("S" & Remplace.Row).Value <> "ABSENT" And Not [B][COLOR=Blue]UCase([/COLOR][/B]Range("S" & Remplace.Row).Value[B][COLOR=Blue])[/COLOR][/B] Like "REMPLACEMENT DE*" Then
 
Re : Transfert entre feuille

Re encore moi,

Suite à une discussion avec mes confrères de travail, ils m’ont demandé s’il était possible de faire une petite modification sur le script.

J’explique.

Si une personne est marquée ABSENT dans la colonne S de la feuille Horaire Viandes, il recherche se nom dans la feuille Remplacement ligne par ligne en commencant par la ligne 3 colonne D vers la droit jusqu’au dernier nom inscrit, si pas trouvé, il va à la ligne 4 et ainsi de suite, jusqu’à ce qui trouve le nom. S’il trouve le nom, il prend la personne qui le remplace (ce nom de remplaçant est dans la colonne A de la même ligne.

Ensuite il marque comme dans l’autre version, Remplacement de .....

Et il passe au prochain marqué ABSENT.

Merci encore. Je garde quand même la dernière version.
 

Pièces jointes

Re : Transfert entre feuille

J'ai commencé à modifier certaines choses.

Code:
Private Sub CommandButton2_Click()
'remplacement du vacancier
  Dim Nom As Range, Trouve As Range, Remplace As Range
  'dans la feuille Remplacement
  With Sheets("Remplacement")
    'pour chaque nom colonne A
    For Each Nom In .Range("D4", .[D100].End(xlToRight)).SpecialCells(xlCellTypeConstants, xlTextValues)
      'trouve cette personne dans Horaire Viandes
      Set Trouve = Columns(1).Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole)
      If Not Trouve Is Nothing Then
        'si cette personne est en vacance
        If Range("S" & Trouve.Row).Value = "ABSENT" Then
          'ici on identifie la colonne correspondant à la personne de remplacement
                 ColChoix = .Range("a" & Trouve.Row).End(xlToRight).Column
          ColChoix = 1
          'la boucle permet de gérer l'absence ou non des personnes remplaçantes
          Do
            'on cherche la personne de remplacement dans la feuille Horaire Viandes
            Set Remplace = Columns(1).Find(.Cells(Nom.Row, ColChoix).Value, LookIn:=xlValues, lookat:=xlWhole)
            'si on se trouve à la fin de la liste de remplacement, message et on sort de la boucle
            If Remplace.Value = "" Then
              MsgBox "Il n'y a personne pour remplacer " & Nom.Value
              Exit Do
            End If          
           
     'si cette personne de remplacement n'est pas également en vacance et ne remplace pas déjà quelqu'un
            If Range("S" & Remplace.Row).Value <> "ABSENT" And Not Range("S" & Remplace.Row).Value Like "Remplacement de*" Then
              'on copie les horaires de la semaine
              Range("E" & Remplace.Row & ":Q" & Remplace.Row).Value = Range("E" & Trouve.Row & ":Q" & Trouve.Row).Value
              Range("E" & Remplace.Row + 1 & ":Q" & Remplace.Row + 1).Value = Range("E" & Trouve.Row + 1 & ":Q" & Trouve.Row + 1).Value
              Range("S" & Remplace.Row) = "Remplacement de  " & Nom
              'on copie horaire colonne D
              Range("D" & Remplace.Row + 1).Value = Range("D" & Trouve.Row + 1).Value
              'on sort de la boucle
              Exit Do
            End If
            'sinon on identifie la colonne correspondant à la personne de remplacement suivante
            ColChoix = ColChoix
    
              Loop
        End If
      End If
    Next
  End With
                 
MsgBox "REMPLACEMENT TERMINÉ"
End Sub


Ce que ça fait, ça fait remplacer la personne en vacance par tout ceux qui on le nom de la personne en vacance.

Pas trop bon.
 
Dernière édition:
Re : Transfert entre feuille

Re encore moi,

Suite à une discussion avec mes confrères de travail, ils m’ont demandé s’il était possible de faire une petite modification sur le script.

J’explique.

Si une personne est marquée ABSENT dans la colonne S de la feuille Horaire Viandes, il recherche se nom dans la feuille Remplacement ligne par ligne en commencant par la ligne 3 colonne D vers la droit jusqu’au dernier nom inscrit, si pas trouvé, il va à la ligne 4 et ainsi de suite, jusqu’à ce qui trouve le nom. S’il trouve le nom, il prend la personne qui le remplace (ce nom de remplaçant est dans la colonne A de la même ligne.

Ensuite il marque comme dans l’autre version, Remplacement de .....

Et il passe au prochain marqué ABSENT.

Merci encore. Je garde quand même la dernière version.

Bonjour,

Qu'est-ce qui ce passe si la ligne suivante ne contient pas de remplaçant.
Dans ton fichier, si par exemple tous les remplaçants de "PELLETIER ROLAND" sont absents on passe directement vers les remplaçants de "JUTRAS YVAN"?
 
Re : Transfert entre feuille

Re bonjour,

Dans la feuille remplaçant, colonne A, se trouve le nom de ceux qui veulent faire du remplacement de vacance par ordre d'ancienneté. À partir de la colonne D de la même ligne, ce trouve le nom des personnes par ordre de préférence qu'il (nom colonne A ) veut remplacer si ses personnes son en vacance (Colonne D à ......)

Donc il est possible que des personnes ne veuillent pas faire du remplacement, donc n’aurons pas de nom dans la colonne D à …….. Dans ce cas, il passe au prochain.

En réalité, il n’y a que la façon de chercher le remplaçant qui change. Le reste, le fait de marquer « remplaçant de » ne change pas.

Merci
 
Re : Transfert entre feuille

re bonjour à tous et bonne année. 🙂

Je reviens avec la suite de mon problème. Je ne pourrais inscrire tous les tests que j'ai faits, car il y en avait trop et le résultat était le même: Ça ne marche pas du tout.

lollllll

Pouvez-vous m'aider là-dessus s.v.p.

Merci Beaucoup.
 
Re : Transfert entre feuille

Bonjour Jean-Marc, bonne année à toi aussi!

Re encore moi,

Suite à une discussion avec mes confrères de travail, ils m’ont demandé s’il était possible de faire une petite modification sur le script.

J’explique.

Si une personne est marquée ABSENT dans la colonne S de la feuille Horaire Viandes, il recherche se nom dans la feuille Remplacement ligne par ligne en commencant par la ligne 3 colonne D vers la droit jusqu’au dernier nom inscrit, si pas trouvé, il va à la ligne 4 et ainsi de suite, jusqu’à ce qui trouve le nom. S’il trouve le nom, il prend la personne qui le remplace (ce nom de remplaçant est dans la colonne A de la même ligne.

Ensuite il marque comme dans l’autre version, Remplacement de .....

Et il passe au prochain marqué ABSENT.

Merci encore. Je garde quand même la dernière version.

Ce que tu demandes là change la façon dont la recherche se fait.
C'était un peu plus qu'une petite modification sur le script.
Voici le code:
Code:
Private Sub CommandButton2_Click()
  Dim Nom As Range, Trouve As Range, Remplace As Range, Debut As String, Suivant As Range, Flag As Boolean
  'dans la feuille Remplacement
  With Sheets("Remplacement")
    'pour chaque nom colonne A
    For Each Nom In .Range("A3", .[A65536].End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
      'trouve cette personne dans Horaire Viandes
      Set Trouve = Columns(1).Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
      If Not Trouve Is Nothing Then
      'si cette personne est absente
        If Range("S" & Trouve.Row).Value = "ABSENT" Then
        'trouve cette personne dans colonne D à IV de "ligne à ligne" (Horaire Viandes)
          Set Trouve2 = .Range("D3:IV65536").Find(Nom.Value, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
          If Not Trouve2 Is Nothing Then
            Debut = Trouve2.Address
            'la boucle permet de gérer l'absence ou non des personnes remplaçantes
            Do
              'on cherche la personne de remplacement dans la feuille Horaire Viandes
              Set Remplace = Columns(1).Find(.Range("A" & Trouve2.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
              'si cette personne de remplacement n'est pas également absente et ne remplace pas déjà quelqu'un
              If Range("S" & Remplace.Row).Value <> "ABSENT" And Not UCase(Range("S" & Remplace.Row).Value) Like "REMPLACEMENT DE*" Then
                'on copie les horaires de la semaine
                Range("E" & Remplace.Row & ":Q" & Remplace.Row).Value = Range("E" & Trouve.Row & ":Q" & Trouve.Row).Value
                Range("E" & Remplace.Row + 1 & ":Q" & Remplace.Row + 1).Value = Range("E" & Trouve.Row + 1 & ":Q" & Trouve.Row + 1).Value
                Range("S" & Remplace.Row) = "REMPLACEMENT DE  " & Nom
                'on copie horaire colonne D
                Range("D" & Remplace.Row + 1).Value = Range("D" & Trouve.Row + 1).Value
                Flag = True
                'on sort de la boucle
                Exit Do
              End If
              Set Suivant = Trouve2
              Set Trouve2 = .Range("D3:IV65536").Find(Nom.Value, after:=Suivant, LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows)
            Loop While Not Trouve2 Is Nothing And Trouve2.Address <> Debut
            If Trouve2.Address = Debut And Not Flag Then
              MsgBox Nom & " n'a pas de remplaçant!", vbExclamation
              Flag = False
            End If
          End If
        End If
      End If
    Next
  End With

End Sub
 
Re : Transfert entre feuille

Bonjour Scoobi,

Il y a une petite erreur dans la façon de faire la recherche.

Dans la liste de la colonne A = personnes en ordre d'ancienneté.

Dans leurs choix de remplacement, ils ne sont pas nécessairement en ordre d'ancienneté.

Ex. : si la personne qui est en 3e position dans le rang de l'ancienneté (Colonne A), veut remplacer en 1er la personne #2, et si la personne #2 n'est pas en vacance, il remplace le #5. Alors il doit respecter ses choix par préférence.

Si aucun n'est en vacance dans ses choix, il passe avec le prochaine en ancienneté dans la colonne A, jusqu'à la fin de la liste.


merci
 
Re : Transfert entre feuille

Pas de problème.

Disons que, selon ancienneté:
Yves = employé #1
Pierre = employé #2
Serge = employé #3
Carl = employé #4

Maintenant, Yves et Pierre sont en vacance.

Serge lui, dans ses choix de préférence de remplacement, il désir remplacer Pierre. Son 2e choix de remplacement est Yves. Donc en réalité, il veut remplacer les 2 plus vieux sauf que s'il a le choix entre les deux et il veut remplacer Pierre en premier.

Donc pour Serge, il sera marqué "Remplacement de Pierre" et non d'Yves.

Si maintenant, Carl, prochain en ancienneté, à comme priorité le choix d'Yves, il sera marqué "Remplacement de Yves".

Et ainsi de suite.

Ces pour cela que la liste de remplacement doit se faire par ordre d'ancienneté dans la colonne A oui, mais les choix de remplacement par ordre de préférence.

matrix
 
Dernière édition:
Re : Transfert entre feuille

Re,

on va peut-être finir par y arriver lol:

Code:
Private Sub CommandButton2_Click()
  Dim Nom As Range, Trouve As Range, Remplace As Range, Debut As String, Suivant As Range, Col As Integer
  'dans la feuille Remplacement
  With Sheets("Remplacement")
    'pour chaque nom colonne A
    For Each Nom In .Range("A3", .[A65536].End(xlUp)).SpecialCells(xlCellTypeConstants, xlTextValues)
      'on cherche cette personne dans la feuille Horaire Viandes
      Set Remplace = Columns(1).Find(.Range("A" & Nom.Row).Value, LookIn:=xlValues, lookat:=xlWhole)
      'si cette personne n'est pas en vacance et ne remplace pas déjà quelqu'un
      If Range("S" & Remplace.Row).Value <> "ABSENT" And Not UCase(Range("S" & Remplace.Row).Value) Like "REMPLACEMENT DE*" Then
        Col = 4
        'on vérifie qu'il y a une liste de remplacement
        If .Range("D" & Nom.Row).Value <> "" Then
          'la boucle permet de gérer l'absence ou non des personnes remplaçantes
          Do
            'on cherche la personne à remplacer dans Horaire Viandes
            Set Trouve = Columns(1).Find(.Cells(Nom.Row, Col).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not Trouve Is Nothing Then
              'si cette personne à remplacer est absente ET n'est pas déjà remplacé par un plus ancien
              If Range("S" & Trouve.Row).Value = "ABSENT" And Columns(19).Find(Trouve.Value, LookIn:=xlValues, lookat:=xlPart) Is Nothing Then
                'on copie les horaires de la semaine
                Range("E" & Remplace.Row & ":Q" & Remplace.Row).Value = Range("E" & Trouve.Row & ":Q" & Trouve.Row).Value
                Range("E" & Remplace.Row + 1 & ":Q" & Remplace.Row + 1).Value = Range("E" & Trouve.Row + 1 & ":Q" & Trouve.Row + 1).Value
                Range("S" & Remplace.Row) = "REMPLACEMENT DE  " & Trouve.Value
                'on copie horaire colonne D
                Range("D" & Remplace.Row + 1).Value = Range("D" & Trouve.Row + 1).Value
                'on sort de la boucle
                Exit Do
              End If
              Col = Col + 1
            End If
          Loop Until .Cells(Nom.Row, Col).Value = ""
        End If
      End If
    Next
  End With

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour