XL 2013 consolidation données

Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mois$, P As Range, w As Worksheet, an, i&, j%, c As Range, n&, k%
mois = LCase(CStr([C11]))
Set P = Range("C14:H" & Rows.Count)
Application.ScreenUpdating = False
Application.EnableEvents = False
On Error Resume Next 'sécurrité
P.Clear 'RAZ
If mois = "" Then GoTo 1
For Each w In Worksheets
    If LCase(CStr(w.Range("P3"))) = mois Then Exit For
Next w
If w Is Nothing Then GoTo 1
an = w.Range("U3")
If Not IsNumeric(CStr(an)) Then an = Year(Date)
For i = 9 To w.Range("A1", w.UsedRange).Rows.Count
    If w.Cells(i, 1) <> "" And Not w.Rows(i).Hidden Then
        For j = 3 To 33
            Set c = w.Cells(i, j)
            If Not IsNumeric(c) And c <> c(1, 0) Then
                n = n + 1
                P(n, 1) = w.Cells(i, 1) 'Nom Prénom
                P(n, 2) = c 'Code
                P(n, 4) = CDate(j - 2 & "/" & mois & "/" & an) 'Du...
                k = 2
                While c(1, k) = c: k = k + 1: Wend
                P(n, 5) = P(n, 4) + k - 2 'Au...
                j = j + k - 2
            End If
        Next j
    End If
Next i
If n Then
    With P.Resize(n)
        .Columns(3) = "=IFERROR(VLOOKUP(RC[-1],Recherche_Code,2,0),"""")"
        .Columns(6) = "=NETWORKDAYS(RC[-2],RC[-1])"
        .Columns(4).Resize(, 3).HorizontalAlignment = xlCenter 'centrage
        .Borders.Weight = xlHairline 'bordures
    End With
End If
1 Application.EnableEvents = True
End Sub

Private Sub Worksheet_Activate()
Worksheet_Change [A1] 'lance la macro
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mois$, P As Range, w As Worksheet, an, tablo, resu, i&, j%, x$, n&, k%
mois = LCase(CStr([C11]))
Set P = Range("C14:H" & Rows.Count)
Application.ScreenUpdating = False
Application.EnableEvents = False
P.Clear 'RAZ
If mois = "" Then GoTo 1
For Each w In Worksheets
    If LCase(CStr(w.Range("P3"))) = mois Then Exit For
Next w
If w Is Nothing Then GoTo 1
an = w.Range("U3")
If Not IsNumeric(CStr(an)) Then an = Year(Date)
tablo = w.Range("A1", w.UsedRange).Resize(, 35).Formula 'matrice, plus rapide
resu = P 'matrice, plus rapide
For i = 9 To UBound(tablo)
    If tablo(i, 1) <> "" Then
        For j = 3 To 33
            x = UCase(tablo(i, j))
            If x = "CAP" Or x = "IMJ" Then 'critères
                n = n + 1
                resu(n, 1) = tablo(i, 1) 'Nom Prénom
                resu(n, 2) = x 'Code
                resu(n, 4) = CDate(j - 2 & "/" & mois & "/" & an) 'Du...
                k = 1
                While UCase(tablo(i, j + k)) = x: k = k + 1: Wend
                resu(n, 5) = resu(n, 4) + k - 1 'Au...
                j = j + k - 1
            End If
        Next j
    End If
Next i
'---restitution---
If n Then
    With P.Resize(n)
        .Value = resu
        .Columns(3) = "=IFERROR(VLOOKUP(RC[-1],Recherche_Code,2,0),"""")"
        .Columns(6) = "=NETWORKDAYS(RC[-2],RC[-1])"
        .Columns(4).Resize(, 3).HorizontalAlignment = xlCenter 'centrage
        .Borders.Weight = xlHairline 'bordures
    End With
End If
1 Application.EnableEvents = True
End Sub

P.Clear 'RAZ

Protect "toto", UserInterfaceOnly:=True 'mot de passe toto à adapter
P.ClearContents 'RAZ
P.Borders.LineStyle = xlNone 'RAZ