Sub Planning2()
MaFeuille = "mise a jour planning" 'Feuille du planning
MaPlage = "C19:I19" 'Plage du planning (les dates)
NbLig = 11 'Nombre de lignes (nb de noms à traiter)
MesCrit = Array("21h15/6h15", "tn", "REPOS", "rp", "CONGES", "cp") 'Criteres à reporter (par paires)
'-------------------Message---------------------
If MsgBox("Attention le planning du " & Sheets(MaFeuille).Range("C7") & " va etre mis à jour." & Chr(10) & "Etes-vous sûr ?", vbOKCancel) = 2 Then Exit Sub
'------------------------------------------------
For Each X In Sheets(MaFeuille).Range(MaPlage)
Marqueur = 0
Onglet = "ABS " & Format(X.Value, "yyyy")
For Each Z In Sheets 'Verifie l'existence de l'onglet destination
If Z.Name = Onglet Then Marqueur = 1
Next
If Marqueur = 0 Then Exit Sub
With Sheets(Onglet)
Lig1 = Application.Match(DateSerial(Year(X.Value), Month(X.Value), 1) * 1, .Range("A1:A400"), 0) + 1 'Ligne où se trouve la date (mois) recherchée
Col1 = Application.Match(X.Value2, .Cells(Lig1, 1).Resize(1, 32), 0) 'Colonne où se trouve la date (jour) recherché
.Cells(Lig1 + 1, Col1).Resize(NbLig, 1).Value = IIf(Weekday(X.Value, 2) > 5, "rp", "cp")
For Each Y In X.Offset(1, 0).Resize(NbLig, 1)
LeNom = Sheets(MaFeuille).Cells(Y.Row, Sheets(MaFeuille).Range(MaPlage).Column + 7).Value 'Nom sur la ligne en cours
Lig2 = Application.Match(LeNom, .Cells(Lig1 + 1, 1).Resize(NbLig, 1), 0) 'offset du nom dans le mois recherché
MonCrit = Application.Match(Y.Value, MesCrit, 0)
If Not IsError(Lig2) Then
If IsError(MonCrit) Then
.Cells(Lig1 + Lig2, Col1).Value = "tj"
Else
.Cells(Lig1 + Lig2, Col1).Value = MesCrit(MonCrit)
End If
End If
Next
End With
Next
End Sub