copie des cellule en fonction d'items

[jeannot68]

Bonjour,

Voici mon probleme:
J'ai 2 fichiers excel :
le 1er ("TRAVAUX REALISES1) est un tableau qui permet a mon équipe de rentrer par jour les travaux qu'ils ont éffectué dans la journée qui retrace la date , le travail effectué, le temps passé et pour quel client.
le 2eme tableau "Copie de HEURES MTE JANVIER" est un tableau que je dois rendre au client "MTE" (colonne G du tableau "TRAVAUX REALISES1) qui precise les taches effectués par jour, par personne et par endroit

Je cherche une solution pour retranscrire automatiquement les travaux du client MTE du tableau ("TRAVAUX REALISES1) vers le tableau "Copie de HEURES MTE JANVIER".
Donc si dans la colonne G(donneurs) de ("TRAVAUX REALISES1) on trouve MTE alors il copie le travail(colonne D) dans le tableau "Copie de HEURES MTE JANVIER" dans le bon onglet et a la bonne date

Exemple
si l'on prend la ligne 14 du tableau ("TRAVAUX REALISES1) FRED a fait de l'éclairage au AMID MAIS pendant 1heure pour le donneur MTE.
J aimerai que dans le tableau "Copie de HEURES MTE JANVIER" a l onglet fRED dans la cellule C5 qui correspond a la date du 2 janvier on retrouve eclairage.
Et si il y a plusieurs travaux pour MTE le meme jour mettre un "+" entre chaque travaux


J espere que c est compréhensible
Merci de votre aide

 

[Robert]

Re : copie des cellule en fonction d'items

Bonjour Jeannot, bonjour le forum,

La macro ci-dessous fonctionne mais rencontre deux problèmes :

Sub recap()
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim ch As String 'déclare la variable ch (CHemin)
Dim nc As String 'déclare la variable nc (Nom du Classeur)
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim j As Byte 'déclare la variable j (Jour)
Dim oc As Object 'déclare la variable cs (Onglet Cible)
Dim t As String 'déclare la variable t (Travail)
Dim h As Byte 'déclare la variable cs (Heure)
Dim l As String 'déclare la variable cs (Lieu)
Dim li As Range 'déclare la variable li (recherche de la LIgne)
Dim col As Range 'déclare la variable col (recherche de la COLonne)

Set cs = ThisWorkbook 'définit la classeur source cs
ch = ThisWorkbook.Path & "\" 'définit la chemin d'accès (à adapter)
nc = "Copie de HEURES MTE JANVIER.xls" 'dénifit le nom du classeur cible (à adapter)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set cc = Workbooks(nc) 'définit le classeur cible (si ce classeur n'est pas ouvert, cela génère une ereur)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err = 0 'annule l'ereur
    Workbooks.Open (ch & nc) 'ouvre le classeur cible
    Set cc = Workbooks(nc) 'définit le classeur cible
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set os = cs.Sheets("Travaux") 'définit l'onglet source
dl = os.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 2 (= B)de l'onglet source
Set pl = os.Range("B2:B" & dl) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Offset(0, 5).Value = "MTE" Then 'condition 1 : si la cellule en colonne G est ;égale à "MTE"
        j = CByte(Day(cel.Value)) 'définit la jour j
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        Set oc = cc.Sheets(cel.Offset(0, 1).Value) 'définit le l'onglet cible (si cet onglet n'existe pas, cela génère une ereur)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err = 0 'annule l'ereur
            MsgBox "L'onglet " & cel.Offset(0, 1).Value & " n'existe pas, cette donnée ne sera pas traité !" 'message
            With cs.Sheets("travaux") 'prend en compte l'onglet "Travaux" du classeur source
                .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 8)).Interior.ColorIndex = 3 'colore la ligne en rouge
            End With 'fin de la prise en compte de l'ongelt "travaux" du classeur source
            GoTo suite 'va à l'e'tiquette "suite"
        End If 'fin de la condition 2
        On Error GoTo 0 'annule la gestion des erreurs
        If Month(cel.Value) = Month(cc.Sheets("MOI").Range("C2")) Then 'condition 3 : si le mois est égal au mois de la cellule C2 du classeur cible onglet "MOI"
            With cs.Sheets("travaux") 'prend en compte l'onglet "Travaux" du classeur source
                .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 8)).Interior.ColorIndex = 6 'colore la ligne en jaune
            End With 'fin de la prise en compte de l'ongelt "travaux" du classeur source
            t = cel.Offset(0, 2).Value 'définit le travail t
            h = CByte(cel.Offset(0, 3).Value) 'définit le nombre d'heures h
            l = cel.Offset(0, 4).Value 'définit le lieu l
            Set li = oc.Columns(1).Find(j, oc.Range("A3"), xlValues, xlWhole) 'définit la ligne li qui recevra les données
            If Not li Is Nothing Then 'condition 4 : si il existe au moins une occurrence de la ligne li trouvée
                li.Offset(0, 1).Value = h 'place le nombre d'heures h
                li.Offset(0, 2).Value = t 'place le travail t
                Set col = oc.Rows(3).Find(l, oc.Range("C3"), xlValues, xlWhole) 'définit la colonne du lieu
                If Not col Is Nothing Then oc.Cells(li.Row, col.Column).Value = "X" 'si il existe au moins une occurrence trouvée du lieu, place un "X" dans la colonne col
            End If 'fin de la condition 4
        End If 'fin de la condition 3
    End If 'fin de la condition 1
suite: 'étiquette
Next cel 'prochaine cellule de la boucle
End Sub

• Tu peux avoir dans l'onglet Travaux plusieurs travaux d'une même personne effectués à la même date (voir par exemple les lignes (13, 14, 19, 21 et 22) mais tu ne laisses dans l'onglet cible (FRED dans cet exemple) qu'une seule ligne par date... Pour le moment le code proposé ne placera que le dernier travail pour la même date. On pourrait concatainer les travaux et additionner les heures mais dans ce cas tu n'auras plus le détail d'heure/Travail.
• Certains noms d'onglet n'existent pas ou ne correspondent pas (ANTHONY et ANTONY, ANTONHY.G et ANTHONY 2). Dans ce cas la donnée n'est pas traitée et la ligne non traitée est colorée de rouge. Les lignes traitées sont colorées de jaune pour faciliter la vérification mais on pourrait supprimer cela...

 

[jeannot68]

Re : copie des cellule en fonction d'items

Bonjour à tous, bonjour Robert

Merci de te pencher sur mon probleme. J ai reglé le souci des noms des onglets ils sont maintenant identiques.
Je ne sais pas trop ou mettre ce code? dans workbook? pourrais tu le mettre dans mes fichiers pour comprendre la chose
De plus est il possible de mettre un "+" entre chaque travaux d'une même personne effectués à la même date sur la meme ligne
merci de ton aide
A+

 

[Robert]

Re : copie des cellule en fonction d'items

Bonjour Jeannot, bonjour le forum,

Puisque tu as réglé le souci, envoie donc le fichier corrigé... Ensuite, Ok pour modifier la macro en mettant un "+" pour différents travaux à la même date mais alors quelle heure faudra-t-il marquer ? La somme ?

 

[jeannot68]

Re : copie des cellule en fonction d'items

Bonjour à tous, bonjour Robert

Ci joint les fichiers modifiés. E n ce qui concerne les heures je les mets manuellement afin de le gerer comme je le souhaite donc pas la peine d'inclure les heures dans le tableau.
Je tiens a signaler que je fais cette opération tout les mois avec parfois de nouveau ouvrier donc de nouveau onglet.
Désolé, jai modifié egalement le nom des fichiers pour plus de compréhension dans les codes car se sont les véritables noms que j utilise
De plus les chemins des fichiers sont
TRAVAUX REALISES = \\Frdt022640\atelier
HEURES MTE JANVIER = D:\ANNEE 2013\FEUILLES D'HEURES + ADM\MTE
Merci de ton aide
Cordialement
@

 

[Robert]

Re : copie des cellule en fonction d'items

Bonjour Jeannot, bonjour le forum,

En pièce jointe le fichier modifié. J'ai ajouté un bouton Recap pour lancer la macro. Les modifications sont :
• ne sont traîtées que les cellules dont la couleur n'est pas jaune (la ligne des données traitées se colore de jaune et donc ne sera pas traîtée une seconde fois...)
• Si un ouvrier est rajouté, la macro affiche un message : Creer un nouvel onglet / oui / non
si Oui la macro créé automatiquement un nouvel onglet portant le nom de la cellule en colonne C (donc plantage si doublons)
si Non, la donnée n'est pas traitée et la ligne se colore de rouge (pour indiquer qu'elle n'a pas été traitée)
• La récupération des heures a été supprimée (mise en commentaire) puisque tu m'as dit que tu faisait ça manuellement
• Les tavaux à la même date sont concatainé et séparés par un " + "
• Un message indique la fin de la macro : Toutes les données ont été traîtées....
Le Code :

Sub recap()
Dim cs As Workbook 'déclare la variable cs (Classeur Source)
Dim ch As String 'déclare la variable ch (CHemin)
Dim nc As String 'déclare la variable nc (Nom du Classeur)
Dim cc As Workbook 'déclare la variable cc (Classeur Cible)
Dim os As Object 'déclare la variable os (Onglet Source)
Dim dl As Long 'déclare la variable dl (Dernière Ligne)
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim no As String 'déclare la variable no (Nom Onglet)
Dim j As Byte 'déclare la variable j (Jour)
Dim oc As Object 'déclare la variable cs (Onglet Cible)
Dim t As String 'déclare la variable t (Travail)
Dim h As Byte 'déclare la variable cs (Heure)
Dim l As String 'déclare la variable cs (Lieu)
Dim li As Range 'déclare la variable li (recherche de la LIgne)
Dim col As Range 'déclare la variable col (recherche de la COLonne)

Set cs = ThisWorkbook 'définit la classeur source cs
ch = "D:\ANNEE 2013\FEUILLES D'HEURES + ADM\MTE\" 'définit la chemin d'accès (à adapter)"
nc = "HEURES MTE JANVIER.xls" 'dénifit le nom du classeur cible (à adapter)
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set cc = Workbooks(nc) 'définit le classeur cible (si ce classeur n'est pas ouvert, cela génère une ereur)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err = 0 'annule l'ereur
    Workbooks.Open (ch & nc) 'ouvre le classeur cible
    Set cc = Workbooks(nc) 'définit le classeur cible
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set os = cs.Sheets("Travaux") 'définit l'onglet source
dl = os.Cells(Application.Rows.Count, 2).End(xlUp).Row 'définit la dernière ligne éditée de la colonne 2 (= B)de l'onglet source
Set pl = os.Range("B2:B" & dl) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    If cel.Offset(0, 5).Value = "MTE" And cel.Interior.ColorIndex <> 6 Then 'condition 1 : si la cellule en colonne G est ;égale à "MTE" et si la cellule n'est pas de couleur jaune
        j = CByte(Day(cel.Value)) 'définit la jour j
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        Set oc = cc.Sheets(cel.Offset(0, 1).Value) 'définit le l'onglet cible (si cet onglet n'existe pas, cela génère une ereur)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err = 0 'annule l'ereur
            If MsgBox("L'onglet " & cel.Offset(0, 1).Value & " n'existe pas ! Voulez-vous le créer ?", vbYesNo, "Attention !") = vbNo Then 'condition 3 : si "Non" au message
                With cs.Sheets("travaux") 'prend en compte l'onglet "Travaux" du classeur source
                    .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 8)).Interior.ColorIndex = 3 'colore la ligne en rouge
                End With 'fin de la prise en compte de l'ongelt "travaux" du classeur source
            Else 'si "Oui au message"
                no = cel.Offset(0, 1).Value
                cc.Sheets("vide").Copy After:=cc.Sheets(cc.Sheets.Count)
                cc.Sheets(cc.Sheets.Count).Name = no
                Set oc = cc.Sheets(no)
                oc.Range("C3").Value = no
                oc.Move Before:=cc.Sheets(cc.Sheets.Count - 3)
            End If 'fin de la condition 3
        End If 'fin de la condition 2
        On Error GoTo 0 'annule la gestion des erreurs
        If Month(cel.Value) = Month(cc.Sheets("MOI").Range("C2")) Then 'condition 3 : si le mois est égal au mois de la cellule C2 du classeur cible onglet "MOI"
            With cs.Sheets("Travaux") 'prend en compte l'onglet "Travaux" du classeur source
                .Range(.Cells(cel.Row, 1), .Cells(cel.Row, 8)).Interior.ColorIndex = IIf(.Range(.Cells(cel.Row, 1), .Cells(cel.Row, 8)).Interior.ColorIndex = 3, 3, 6) 'colore la ligne en jaune
            End With 'fin de la prise en compte de l'ongelt "travaux" du classeur source
            t = cel.Offset(0, 2).Value 'définit le travail t
            'h = CByte(cel.Offset(0, 3).Value) 'définit le nombre d'heures h
            l = cel.Offset(0, 4).Value 'définit le lieu l
            Set li = oc.Columns(1).Find(j, oc.Range("A3"), xlValues, xlWhole) 'définit la ligne li qui recevra les données
            If Not li Is Nothing Then 'condition 4 : si il existe au moins une occurrence de la ligne li trouvée
                'li.Offset(0, 1).Value = IIf(li.Offset(0, 1).Value = "", h, "") 'place le nombre d'heures h si un seul travail, sinon efface
                li.Offset(0, 2).Value = IIf(li.Offset(0, 2).Value = "", t, li.Offset(0, 2).Value & " + " & t) 'place le travail t
                Set col = oc.Rows(3).Find(l, oc.Range("C3"), xlValues, xlWhole) 'définit la colonne du lieu
                If Not col Is Nothing Then oc.Cells(li.Row, col.Column).Value = "X" 'si il existe au moins une occurrence trouvée du lieu, place un "X" dans la colonne col
            End If 'fin de la condition 4
        End If 'fin de la condition 3
    End If 'fin de la condition 1
suite: 'étiquette
Next cel 'prochaine cellule de la boucle
MsgBox "Toutes les données ont été traîtées sauf d'éventuelles lignes en rouge !"
End Sub

Le fichier:

 

[jeannot68]

Re : copie des cellule en fonction d'items

Bonjour a tous, bonjour robert

C'est exactement ce a quoi j'imaginai merci. Ca marche corretement
J'ai juste encore quelques questions pour le rendre parfait

1/Quand le message " L'onglet n'existe pas ! Voulez-vous le créer ?" le bouton NON n'a pas l air de marcher je suis obligé de cliquer sur oui pour continuer.
2/ est il possible que lorsque je click sur le bouton Recap un message me demande de selectionner le mois des feuilles d'heures qui se trouve dans D:\ANNEE 2013\FEUILLES D'HEURES + ADM\MTE\ afin d'éviter de changer dans le code tout les mois.
si je selectionne AVRIL alors il m'ouvre de fichier "HEURES MTE AVRIL.xls" et rentre les différentes informations

encore merci cela va me faire gagner un temps enorme dans mon travail
cordialement

 

[Robert]

Re : copie des cellule en fonction d'items

Bonjour Jeannot, bonjour le forum,

En pièce jointe ton fichier modifié. J'ai rajouté une boité d'entrée m au début du code qui demande à l'utilisateur d'entrer le mois au format "mm" la variable mois récupère ce mois au format lettre en majuscules. Prend garde à ce que le nom des fichiers corresponde bien avec les accents (FÉVRIER, AOÛT, DÉCEMBRE).
Je n'ai pas rencontré de problème au niveau de la création d'un nouvel onglet chez moi. Si je répond Non, l'onglet n'est pas créé, la ligne est colorée de rouge, la macro poursuit sont cours jusqu'à la fin...

 

[jeannot68]

Re : copie des cellule en fonction d'items

Bonjour Robert, boujour le forum
Cela marche uniquement si j'ai des données pour le mois de janvier. Mais des que je veux rentrer ceux de FEVRIER cela me donne
"Erreur d'éxécution '9': L'indice n'appartient pas à la sélection.
je tape bien 02 et mon nom de fichier est bien HEURES MTE FÉVRIER comme tu l'as indiqué

voici la ligne de code du probleme qui s'affiche en jaune : Set cc = Workbooks(nc) 'définit le classeur cible
J espere que ca te dit quelque chose
Merci
A+

 

[Robert]

Re : copie des cellule en fonction d'items

Bonjour Jeannot, bonjour le forum,

En effet, j'avais testé mais pas avec un fichier FÉVRIER. Il y avait une erreur dans le code, désolé. En pièce jointe le fichier modifié :

 

[jeannot68]

Re : copie des cellule en fonction d'items

Un grand merci a toi robert. tout marche tres bien.Je gagne un temps énorme dans mon travail
Encore merci de ta participation
Peut etre a une prochaine pour de nouvelles aventures dans excel
Merci