Copier d'une feuille a une autre sous conditions d'intersect

Question

Apres plusieurs recherches sur le site j'ai pas reussi a trouvé mon bonheur, malgré qu'il y a plusieurs cas semblables... Mon objectif est de pouvoir copier 2 cellules (D6 + E6) de plusieurs feuilles de départ(identiques) vers d'autres feuilles (arrivée) avec l'intersection de 2 conditions Condition 1 : il faut que le nom qui figure dans la feuille du départ (B6) correspond a un des noms (de B4 a L4 et de Q4 a AC4) condition 2 : la date dans la cellule C6 de la feuille du départ doit correspondre a la date inscrite dans la feuille d'arrivée ( de A6 a A36) En faite je dois copier le travail de "Bernard "Tous les jours de la feuille de départ (saisie) vers la feuille d'arrivée (stockage donnée) NB:Le nombre de feuilles des collaborateurs peut varier (feuilles de départs) Le nombre de feuilles d'arrivées sont 12 (les 12 mois de l'année. En vba j'ai trouvé plusieurs tuto de type " Set Cel = .Range("A1:A" & LgDer).Find(what:=CDate("A35"), LookIn:=xlValues, lookat:=xlWhole)" Mais j'ai pas reussi a l'appliquer a mon projet J'espere que quelq'un pourra m'aider J'ai essayé de m'exprimer au mieux mais j'ai mis Ci-joint un fichier avec plus de précisions et d’explications. Merci d'avance de votre aide...

h2so4 · Accepted Answer

Voici le code corrigé, Sub copiemois() ' lib = tableau avec les libellés des mois Dim lib lib = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE") ' on parcourt toutes les feuilles du classeur For Each ws In ThisWorkbook.Worksheets For i = 1 To 12 If lib(i - 1) = ws.Name Then i = 99: Exit For Next ' il ne s'agit pas d'une feuille mois, il s'agit donc d'une feuille "employé" If i &lt; 99 Then ' on détermine le mois sur base de la date trouvée en C6 sur le feuille "employé" mois = Month(ws.Range("C6")) ' ws1 fait référence à la feuille indiquée par le mois Set ws1 = Worksheets(lib(mois-1)) ' on y recherche le nom de l'employé (B6) Set nom = Rows(4).Find(ws.Cells(6, 2)) ' l'employé est trouvé If Not (nom Is Nothing) Then ' on détermine le jour du mois sur base de la date trouvée en C6 jour = Day(ws.Range("C6")) ' on copie D6 et E6 sur la ligne correspondant au jour ws1.Cells(jour + 5, nom.Column) = ws.Range("D6") ws1.Cells(jour + 5, nom.Column + 1) = ws.Range("E6") End If End If Next End Sub...

h2so4 · Answer

Une proposition de solution Sub copiemois() ' lib = tableau avec les libellés des mois Dim lib lib = Array("JANVIER", "FEVRIER", "MARS", "AVRIL", "MAI", "JUIN", "JUILLET", "AOUT", "SEPTEMBRE", "OCTOBRE", "NOVEMBRE", "DECEMBRE") ' on parcourt toutes les feuilles du classeur For Each ws In ThisWorkbook.Worksheets For i = 1 To 12 If lib(i - 1) = ws.Name Then i = 99: Exit For Next ' il ne s'agit pas d'une feuille mois, il s'agit donc d'une feuille "employé" If i &lt; 99 Then ' on détermine le mois sur base de la date trouvée en C6 sur le feuille "employé" mois = Month(ws.Range("C6")) ' ws1 fait référence à la feuille indiquée par le mois Set ws1 = Worksheets(lib(mois)) ' on y recherche le nom de l'employé (B6) Set nom = Rows(4).Find(ws.Cells(6, 2)) ' l'employé est trouvé If Not (nom Is Nothing) Then ' on détermine le jour du mois sur base de la date trouvée en C6 jour = Day(ws.Range("C6")) ' on copie D6 et E6 sur la ligne correspondant au jour ws1.Cells(jour + 5, nom.Column) = ws.Range("D6") ws1.Cells(jour + 5, nom.Column + 1) = ws.Range("E6") End If End If Next End Sub...