Microsoft 365 Tri et Import

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [B1]) Is Nothing Then
        Dim NomFichier$, NomFeuille$, DL%, Wkb, N%, i%
        NomFichier = "Essai.xlsm"                                   ' A mettre à jour
        NomFeuille = "Master"                                       ' A mettre à jour
        Application.ScreenUpdating = False
        Set Wkb = GetObject(ThisWorkbook.Path & "\" & NomFichier)   ' Accès fichiet
        Tablo = Wkb.Sheets(NomFeuille).[A1].CurrentRegion           ' Tranfert données dans Tablo
        For i = 11 To UBound(Tablo, 2)                              ' Recherche de la colonne qui correspond à la semaine
            If Tablo(2, i) = Target Then Colonne = i: Exit For
        Next i
        If i = 1 + UBound(Tablo, 2) Then Exit Sub                   ' Semaine non trouvée
        [A4:D255].ClearContents                                     ' Effacement feuille
        N = 0
        For i = 3 To UBound(Tablo)                                  ' Pour toutes les lignes
            If Tablo(i, Colonne) = "x" Then                         ' Si la semaine est correcte
                N = N + 1: Ligne = 2 * N + 2                        ' Calcul du N° de ligne où écrire
                Cells(Ligne, "A") = Tablo(i, 2) ' Nom               ' Transfert données.
                Cells(Ligne, "B") = Tablo(i, 3) ' Prénom
                Cells(Ligne, "C") = Tablo(i, 1) ' Ref
                Cells(Ligne, "D") = Tablo(i, 8) ' Tel
            End If
        Next i
    End If
Fin:
End Sub