Code VBA pour transposer données colorées dans un autre tableau

Question

Tous les mois nous effectuons un emploi du temps collectif de nos employés, une fois que celui ci est terminé, nous reportons l'ensemble de ces données dans des tableaux (un tableau par salarié). Cependant, nous les reportons manuellement, en effet nous ne pouvons pas les copier coller, les tableaux ne sont pas établis de la même manière. L'emploi du temps collectif que vous pouvez trouver en PJ est fait de cette manière : -Colonne A les dates -Colonne B les heures du matin (07:30-13:00) -Colonne C les heures de l'après midi (16:00-19:30) et ainsi de suite pour l'ensemble des salariés Les emplois du temps individuels que vous pouvez aussi trouver en pièce jointe sont disposé de la manière suivante : -Colonne A les dates -Colonne B l'heure d'embauche du matin (7:00) -Colonne C l'heure de débauche du matin (13:00) -Colonne E l'heure d'embauche de l'après midi (16:00) -Colonne F l'heure de débauche l'après midi (19:30) Je ne vous ai pas mentionné les autres colonnes car il s'agit seulement de somme des cellules ci dessus. Nous n'avons pas disposé les tableaux de la même façon, sinon l'emploi du temps collectif serait trop étalé. Pour effacer cette tâche répétitive j'ai essayé cette formule : =SI(OU(ESTVIDE('Emploi du temps collectif 06'!B3); 'Emploi du temps collectif 06'!B3="repos"); "00:00"; SI(ESTERREUR(TROUVE("-"; 'Emploi du temps collectif 06'!B3)); "repos"; GAUCHE('Emploi du temps collectif 06'!B3; TROUVE("-"; 'Emploi du temps collectif 06'!B3)-1))) et celle ci : =SI(OU(ESTVIDE('Emploi du temps collectif 06'!B3); 'Emploi du temps collectif 06'!B3="repos"); "00:00"; SI(ESTERREUR(TROUVE("-"; 'Emploi du temps collectif 06'!B3)); "repos"; SI(TROUVE("-"; 'Emploi du temps collectif 06'!B3) = LONGUEUR('Emploi du temps collectif 06'!B3); "00:00"; DROITE('Emploi du temps collectif 06'!B3; LONGUEUR('Emploi du temps collectif 06'!B3) - TROUVE("-"; 'Emploi du temps collectif 06'!B3))))) Afin d'extraire les donnés avant le tiret et après le tiret, de les reporter dans les cellule colonne "matin" et "après midi" de la feuille de l'emploi du temps individuel. Cela fonctionne, mais ne reporte pas les couleurs, et nous en avons besoin car chaque couleur représente un établissement. De ce fait j'ai utilisé un code VBA, ne connaissant rien en ce langage je me suis aidé de chatgpt. Celui ci m'a fourni un code (voir Word PJ), il reporte les données ainsi que les couleurs. Cependant il y'a une erreur sur le report des couleurs, certaine cellules ont la bonne couleur d'autre non. (voir le 07/06/24 cellule 9, 22/06/24 cellule 24, 23/06/24 cellule 25...) J'ai utilisé la macro uniquement pour la feuille S1, ne fonctionnant pas je n'en ai pas encore crée une par salarié. Que dois je modifier pour que celui ci reporte bien les bonnes couleurs? Dans le cas ou cela fonctionne, suis je obligé de modifier le code pour chaque salarié, en effet la plage des cellules à reporter n'est pas la même? Je vous remercie par avance pour votre aide, et j'espère que mes questionnement sont assez claires, ce n'est pas évident d'exposer mon problème...

LouReeD · Accepted Answer

Votre fichier : en retour avec cette macro : Sub testLRD() ' on arrête la mise à jour de l'écran, c'est plus propre Application.ScreenUpdating = False ' on boucle sur les feuilles du classeur à partir de la deuxième For i = 2 To Worksheets.Count ' on lance la procédure Transfert avec le nom de la feuille concernée ainsi que sa référence de la colonne du matin Call Transfert(Sheets(i).Name, (i - 1) * 2) Next i End Sub Sub Transfert(Qui, ColS) Dim ShS As Worksheet, ShD As Worksheet, ColM As Integer, ColP As Integer, Lig As Integer Set ShS = Sheets(1) Set ShD = Sheets(Qui) ' numéro de la colonne du matin ColM = ColS ' numéro de la colonne de l'après midi ColP = ColS + 1 ' on boucle sur les 31 lignes maxi d'un mois For Lig = 3 To 33 ' si la cellule en colonne 1 n'est pas vide = une date If ShS.Cells(Lig, 1) &lt;&gt; "" Then ' si ce n'est pas inscrit REPOS et que la cellule n'est pas vide If ShS.Cells(Lig, ColM) &lt;&gt; "REPOS" And ShS.Cells(Lig, ColM) &lt;&gt; "" Then ' on split la donnée avec comme séparateur le "-" tablo = Split(ShS.Cells(Lig, ColM), "-") ' on inscrit les différentes valeurs dans les bonnes colonnes ShD.Cells(Lig, 2).Value = Format(tablo(0), "hh:mm:ss") ' on met le texte en couleur ShD.Cells(Lig, 2).Font.Color = ShS.Cells(Lig, ColM).Font.Color ' on met le fond en couleur ShD.Cells(Lig, 2).Interior.Color = ShS.Cells(Lig, ColM).Interior.Color ShD.Cells(Lig, 3).Value = Format(tablo(1), "hh:mm:ss") ShD.Cells(Lig, 3).Font.Color = ShS.Cells(Lig, ColM).Font.Color ShD.Cells(Lig, 2).Interior.Color = ShS.Cells(Lig, ColM).Interior.Color ' sinon Else ' on inscrit 0 dans la cellule ShD.Cells(Lig, 2).Value = Format(0, "hh:mm:ss") ShD.Cells(Lig, 2).Font.Color = ShS.Cells(Lig, ColM).Font.Color ShD.Cells(Lig, 2).Interior.Color = ShS.Cells(Lig, ColM).Interior.Color ShD.Cells(Lig, 3).Value = Format(0, "hh:mm:ss") ShD.Cells(Lig, 3).Font.Color = ShS.Cells(Lig, ColM).Font.Color ShD.Cells(Lig, 3).Interior.Color = ShS.Cells(Lig, ColM).Interior.Color End If ' ici on fait pareil avec la colonne d el'après midi If ShS.Cells(Lig, ColP) &lt;&gt; "REPOS" And ShS.Cells(Lig, ColP) &lt;&gt; "" Then tablo = Split(ShS.Cells(Lig, ColP), "-") ShD.Cells(Lig, 5).Value = Format(tablo(0), "hh:mm:ss") ShD.Cells(Lig, 5).Font.Color = ShS.Cells(Lig, ColP).Font.Color ShD.Cells(Lig, 5).Interior.Color = ShS.Cells(Lig, ColP).Interior.Color ShD.Cells(Lig, 6).Value = Format(tablo(1), "hh:mm:ss") ShD.Cells(Lig, 6).Font.Color = ShS.Cells(Lig, ColP).Font.Color ShD.Cells(Lig, 6).Interior.Color = ShS.Cells(Lig, ColP).Interior.Color Else ShD.Cells(Lig, 5).Value = Format(0, "hh:mm:ss") ShD.Cells(Lig, 5).Font.Color = ShS.Cells(Lig, ColP).Font.Color ShD.Cells(Lig, 5).Interior.Color = ShS.Cells(Lig, ColP).Interior.Color ShD.Cells(Lig, 6).Value = Format(0, "hh:mm:ss") ShD.Cells(Lig, 6).Font.Color = ShS.Cells(Lig, ColP).Font.Color ShD.Cells(Lig, 6).Interior.Color = ShS.Cells(Lig, ColP).Interior.Color End If ' sinon Else ' on incrit "vide" dans toutes les colonnes ShD.Cells(Lig, 2).Value = "" ShD.Cells(Lig, 2).Interior.Color = ShS.Cells(Lig, ColM).Interior.Color ShD.Cells(Lig, 3).Value = "" ShD.Cells(Lig, 3).Interior.Color = ShS.Cells(Lig, ColM).Interior.Color ShD.Cells(Lig, 5).Value = "" ShD.Cells(Lig, 5).Interior.Color = ShS.Cells(Lig, ColP).Interior.Color ShD.Cells(Lig, 6).Value = "" ShD.Cells(Lig, 6).Interior.Color = ShS.Cells(Lig, ColP).Interior.Color End If ' on passe à la ligne suivante Next Lig End Sub @ bientôt LouReeD...

LouReeD · Answer

Merci pour votre retour et vos remerciements ! Il y a peut-être plus simple au niveau code, mais comme vous l'avez vu cela tourne bien ! @ bientôt LouReeD...