XL 2019 Macro bloque en court de travail

[Jiheme]

Bonjour
Cette macro écrite avec l'aide des passionnés de ce forum doit récupérer dans un tableau de 1700 lignes tous les joueurs d'un club donné pour les copier sur la feuille du club en question, j'ai donc 14 macros identiques (à l'exception des feuilles de destination des données) toutes les macros ont le même problème.
Tout fonctionnait correctement et lorsque j'ai voulu faire une mise à jour après avoir renseigné les derniers résultats, la macro bloque après avoir commencé le travail normalement elle s'arrête à la fin des joueurs dont le nom commence par C et ce quelque soit le club concerné.
La macro se déclenche par un double clic sur la cellule B1 de la feuille de club.
Je comprend d'autant moins que je n'ai rien changé dans la macro ni dans le tableau de réception.
Le message d'erreur est : Erreur 13 - Incompatibilité de type
Merci d'avance

 

[Dranreb]

Bonjour.
L'erreur vient de la cellule '[TEST TOP 14.xlsm]Joueurs'!C360, formule =SI(#REF!<>"";#REF!;"") valant #REF!. Une valeur de type Error ne peut en effet pas être comparée à une expression String.

 

[fanfan38]

Bonjour
Quelques modifications
Les données ont été converti en tableau structuré
1 seul macro pour toutes les feuilles
la macro de la feuille du club

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

AS Rochelais étant le nom du club (comme indiqué dans la liste des joueurs)
La seul macro est dans le module 2 copie(nom du club)

A+ François
Ps: je ne sais pas pour "ot filtre"

 

[Phil69970]

Bonjour à tous

@Jiheme
Je te propose ce fichier
Dans toutes tes feuilles de club remplacent le code du double clic par celui ci :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([B1], Target) Is Nothing Then CopieJoueurs
Cancel = True
End Sub

Tu as maintenant qu'une seule macro qui fait toutes les feuilles

A noter :
J'ai corrige la faute d'orthographe en B1 sur la feuille AS Roch pour que la macro fonctionne ..... (il faut 1 seul L)
J'ai commenté tout le code VBA

Merci de ton retour

 

[fanch55]

Bonjour à tous,
@Jiheme , les tableaux auraient gagné à être de type structuré .
Pas la peine d'avoir trente six codes pour les différents club,
Le code proposé ci-dessous devrait suffire :

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