XL 2019 Macro bloque en court de travail

 If Not Intersect([B1], Target) Is Nothing Then copie ("AS Rochelais") ' COP_AS_ROCH

Sub Test()
    CopyTo Worksheets("AS ROCH"), "AS Rochelais"
'    CopyTo Worksheets("Toulon"), "Rc Toulon"
End Sub

Sub CopyTo(Feuille_Club As Worksheet, Club As String)
Dim Destination As Range, Start As Range, Zone As Range
Application.ScreenUpdating = False
    With Feuille_Club
        .Select
        .Unprotect
        Set Start = .Columns("A").Find("Prénom")
        Set Destination = Start.Offset(1)
        .Range(Destination, Cells(Application.Max(15, .Cells(.Rows.Count, "A").End(xlUp).Row), "I")).ClearContents
        .Columns("C").ColumnWidth = 10 ' les colonnes de largeur 0 posent problème lors des copies
    End With
    
    With Sheets("Joueurs")
        .Columns("C").ColumnWidth = 10
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Range("$A$1", .Cells(.Rows.Count, "I").End(xlUp))
            .AutoFilter Field:=.Columns("I").Column, Criteria1:=Club
            For Each Zone In .SpecialCells(xlCellTypeVisible).Areas
                Zone.Copy Destination
                Set Destination = Destination.Offset(Zone.Rows.Count)
            Next
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
        .Columns("C").ColumnWidth = 0
    End With
    
    With Feuille_Club
         Start.Offset(1).EntireRow.Delete
        .Columns("C").ColumnWidth = 0
        .Protect
        .Activate
        ActiveWindow.ScrollRow = Start.Row
    End With

End Sub