XL 2010 Alimentation planning en fonction de données sur une feuille

Sub MAJ_Plannings()
Dim P As Range, rc&, ligdeb&, lig&, w As Worksheet, mois As Byte, i&, j As Variant
Set P = Sheets("données").[A1].CurrentRegion
rc = P.Rows.Count
ligdeb = 3 '1ère ligne à renseigner, à adapter
lig = ligdeb
Application.ScreenUpdating = False
For Each w In Worksheets
    If IsDate("1/" & w.Name) Then
        With w.Rows(ligdeb & ":" & w.Rows.Count)
            .ClearContents 'RAZ
            .Interior.ColorIndex = xlNone 'RAZ
            .Borders.LineStyle = xlNone 'RAZ bordures
        End With
        mois = Month("1/" & w.Name)
        For i = 2 To rc
            If IsDate(P(i, 5)) Then
                If Month(P(i, 5)) = mois Then
                    w.Cells(lig, 1).Resize(, 4) = P(i, 1).Resize(, 4).Value
                    j = Application.Match(P(i, 5), w.Rows(1), 0)
                    If IsNumeric(j) Then w.Cells(lig, j) = P(i, 6)
                    lig = lig + 1
                End If
            End If
        Next i
        If lig > ligdeb Then w.Range("A" & ligdeb & ":I" & lig - 1).Borders.Weight = xlThin 'bordures
    End If
Next w
End Sub

Sub MAJ_Plannings()
Dim ligdeb&, d As Object, tablo, w As Worksheet, nf$, col%, i&, dat As Variant, lig As Variant
ligdeb = 3
Set d = CreateObject("Scripting.Dictionary")
tablo = Sheets("données").[A1].CurrentRegion.Resize(, 6) 'matrice, plus rapide
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
For Each w In Worksheets
    nf = UCase(Trim(w.Name))
    If IsDate("1/" & nf) Then
        d.RemoveAll 'RAZ
        If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
        '---effacement des DI sans toucher aux POS---
        For col = 10 To 70 Step 2
            With w.Cells(ligdeb, col).Resize(w.Rows.Count - ligdeb + 1)
                .ClearContents
                .Interior.ColorIndex = xlNone
            End With
        Next col
        For i = 2 To UBound(tablo)
            dat = tablo(i, 5)
            If IsDate(dat) Then
                dat = CDate(dat)
                If Year(dat) = [année] And UCase(Format(dat, "mmmm")) = nf Then
                    ThisWorkbook.Names.Add "Critere", tablo(i, 1) & tablo(i, 4) 'nom défini
                    With w.Range("A1", w.UsedRange)
                        .Columns(1).Name = "Matricule" 'plages nommées
                        .Columns(4).Name = "Activite" 'plages nommées
                    End With
                    lig = [MATCH(Critere,Matricule&Activite,0)]
                    If IsError(lig) Then lig = Application.Max(ligdeb, w.Cells(w.Rows.Count, 1).End(xlUp).Row + 1)
                    d(lig) = "" 'mémorise les lignes traitées
                    w.Cells(lig, 1).Resize(, 4) = Application.Index(tablo, i, 0)
                    col = Application.Match(CLng(dat), w.Rows(1), 0)
                    Application.EnableEvents = True 'réactive les évènements pour appliquer la couleur
                    w.Cells(lig, col) = tablo(i, 6)
                    Application.EnableEvents = False 'désactive les évènements
                End If
            End If
        Next i
        '---suppression des lignes non traitées---
        For i = w.Cells(w.Rows.Count, 1).End(xlUp).Row To ligdeb Step -1
            If Not d.exists(i) Then w.Rows(i).Delete
        Next i
    End If
Next w
Application.EnableEvents = True 'réactive les évènements
MsgBox "Les plannings ont été mis à jour", vbInformation
End Sub