XL 2010 Gestion absence enseignant

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

Private Sub Worksheet_Change(ByVal Target As Range)
Dim critere$, lig&, i&
critere = UCase([B1]) & "*"
lig = 1
Application.ScreenUpdating = False
Application.EnableEvents = False 'désactive les évènements
If Target.Address = "$B$1" Then [B1].Select
Rows("2:" & Rows.Count).Delete 'RAZ
With Sheets("Source")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Cells(1, 3).Resize(, .Columns.Count - 2).Copy Cells(1, 3)
    For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
        If UCase(.Cells(i, 2)) Like critere And Application.CountA(.Cells(i, 3).Resize(, .Columns.Count - 2)) Then
            lig = lig + 1
            .Rows(i).Copy Cells(lig, 1)
        End If
    Next i
End With
For i = Cells(1, Columns.Count).End(xlToLeft).Column To 3 Step -1
    If Application.CountA(Columns(i)) < 2 Then Columns(i).Delete
Next i
With [B1].Validation 'liste de validation
    .Delete 'RAZ
    .Add xlValidateList, Formula1:="=B2:B" & lig
    .ShowError = False
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

Private Sub Worksheet_Activate()
ComboBox1_Change 'lance la macro
End Sub

Private Sub ComboBox1_GotFocus()
ComboBox1_Change 'lance la macro
End Sub

Private Sub ComboBox1_Change()
Dim critere$, lig&, i&
critere = UCase(ComboBox1) & "*"
lig = 1
Application.ScreenUpdating = False
Rows("2:" & Rows.Count).Delete 'RAZ
With Sheets("Source")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Cells(1, 3).Resize(, .Columns.Count - 2).Copy Cells(1, 3)
    For i = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
        If UCase(.Cells(i, 2)) Like critere And Application.CountA(.Cells(i, 3).Resize(, .Columns.Count - 2)) Then
            lig = lig + 1
            .Rows(i).Copy Cells(lig, 1)
        End If
    Next i
End With
For i = Cells(1, Columns.Count).End(xlToLeft).Column To 3 Step -1
    If Application.CountA(Columns(i)) < 2 Then Columns(i).Delete
Next i
If lig > 1 Then ComboBox1.List = Range("B2:C" & lig).Value Else ComboBox1.Clear
End Sub