Macro de copiage se plante suite a une modification dans le classeur

[Tazko]

Bonjour,

J'ai un code qui fonctionnait bien (voir ci dessous)

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 < 99 Then
  ' on détermine le mois sur base de la date trouvée en C6 sur le feuille "employé"
'  With
 
 
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é (B4)
Set nom = Rows(4).Find(ws.Cells(4, 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

J'ai rajouté d'autres feuilles dans le classeur (suivi, stock, paiement.....) qui ne sont pas concernés par ce code , et depuis le code a plante.il plante a la ligne 17 et a la ligne 28 car pour lui il doit boucler sur les feuilles avec les mois (12) et des feuilles avec des noms des collaborateurs (en C6 date), je pense qu'il ne reconnait pas les feuilles rajoutés, je pense que je dois boucler le code sur seulement les feuilles des collaborateurs (avec Array) ou gerer l'erreur avec (On error resume next...)quand la feuille du collaborateur n'existe pas ;mais dans les 2 cas j'ai pas pu y aller plus loin...

Pour conclure j'ai mis en pièce jointe 2 fichiers :
1-avec le code qui fonctionne
2-avec le code qui plante (rajout des feuilles)

Si quelqu'un peut m'aider S'il vous plait.

Amicalement

 

[sousou]

Re : Macro de copiage se plante suite a une modification dans le classeur

Bonjour
Peut-être pas la solution la meilleur, mais la plus proche de ce que tuas initié.
Test si c6 cela feuille est une date sinon suivante
Pourquoi pas la meilleur? si tu ajoutes une autre feuille, qui n'est pas une feuille employé, avec une date en c6.....alors erreur...

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 < 99 Then
' on détermine le mois sur base de la date trouvée en C6 sur le feuille "employé"
If IsDate(ws.Range("c6")) = True Then
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
End If
Next
End Sub

 

[Tazko]

Re: Re : Macro de copiage se plante suite a une modification dans le classeur

Bonjour Sousou,

Merci pour ta réponse rapide, en effet ça l'air de fonctionner même si j'ai des feuilles (hors collaborateurs) avec un date en C6.

Je ferais encore des tests cette semaine, Je ferme pas le sujet tant que je ne suis pas sure a 100%.

Merci encore & bonne soirée

 

[Tazko]

Bonjour sousou, forum,

Merci ça fonctionne bien

Amicalement