XL 2010 Erreur d'éxécution 1004 sur VBA

[gservas]

Bonjour
Je fais appel à vos connaissances car j'ai un code VBA que Fanch55 a créé pour moi mais j'ai une erreur lors de la manipulation du fichier pour changer le chiffre dans la cellule dans la colonne nombre de lignes.

L'erreur est Erreur d'éxécution '1004'
Le déplacement des cellules dans un tableau de votre feuille de calcul n'est pas autorisé

L'erreur sur la macro se situe à la ligne TabMain.ListRows.Add 1 dans la macro ci-dessous :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Get_Tabmain(Sh) Then
Application.EnableEvents = False
TabMain.DataBodyRange.Rows.Delete
For Each Lobj In Sh.ListObjects
If Lobj.Name <> TabMain.Name Then
TabMain.ListRows.Add 1
TabMain.ListColumns("Tableau").DataBodyRange(1) = Lobj.Name
End If
Next
Application.EnableEvents = True
Info_Tableau Sh
End If

End Sub

Le probléme vient peut être du fait que le nombre de ligne (dans le tableau sur fond bleu) est issue d'une formule matricielle (qui ressemble à celle ci-dessous) qui calcule le nombre de ligne nécessaire au tableau. Cette formule n'est pas mise dans le fichier exemple car il n'est pas possible d'insérer une formule dans ce tableau.
=MAX(SI(ESTNUM(CHERCHE(F4;Récap_PSPeurs_départemental[Concat classement pspeur départemental]));CNUM(SUBSTITUE(Récap_PSPeurs_départemental[Concat classement pspeur départemental];F4))

Les pistes (non exhaustives) que j'ai trouvé sont :
- convertir les tableaux en plage (est-ce que cela peut débloquer la situation, mais je perdrai les filtres et l'insertion automatique des formules dans mon tableau) Dans l'exemple je n'ai pas mis de formule pour simplifier.
- la colonne ligne n'est pas la colonne la plus à gauche dans mon tableau mais la seconde. Dois-je inverser les 2 colonnes pour que cela puisse fonctionner. Ce n'est pas le cas dans mon fichier exemple.

Le fichier fonctionne par la table de contrôle qui a l’entête de colonne "Nombre de lignes" avec un commentaire "TabMain" , est exécuté pour chaque feuille activée.

Je vous joins un fichier exemple mais sur ce fichier l'erreur n'apparait pas pour vous aider car je ne peux pas envoyer mon fichier complet car il est confidentiel.

Merci pour aide.
GS

 

[gservas]

Bonjour
Voici un extrait du fichier que j'utilise.
Le principe est que j'aimerai changer le département dans l'onglet inscription club et que les tableaux s'adaptent (en nombre de ligne) automatiquement comme par exemple dans l'onglet classement PSPeur départemental (exemple 94 puis 91).
Le chiffre du nombre de ligne du tableau est inscrit dans le tableau nommé en commentaire TabMain.
Merci pour votre aide.
GS

 

[gservas]

Bonsoir
Personne ne connait la solution à ce problème.
Merci pour votre aide
GS

 

[Dranreb]

Bonsoir.
À tout hasard essayez :

                    TabMain.ListRows.Add 1, AlwaysInsert:=True

 

[job75]

Bonjour gservas, Bernard,

Perso j'aurais utilisé :

Dim TabMain As ListObject

Function Get_Tabmain(ByVal Sh As Object) As Boolean
    Set TabMain = Nothing
    On Error Resume Next
    Set TabMain = Sh.Cells.Find("TabMain", , xlComments).ListObject
    Get_Tabmain = Not TabMain Is Nothing
End Function

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim P As Range, c As Range
    If Get_Tabmain(Sh) Then
        Set P = TabMain.Range
        Application.EnableEvents = False
        On Error Resume Next
        P.Rows(2).Resize(P.Rows.Count - 1).Delete xlUp 'RAZ
        For Each Lobj In Sh.ListObjects
            If Lobj.Name <> TabMain.Name Then
                Set c = P(1).EntireColumn.Find("", P(1), xlValues)
                c = Lobj.Name
                c(1, 2) = Lobj.Range.Rows.Count - 1
            End If
        Next
        Application.EnableEvents = True
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Workbook_SheetActivate Sh
End Sub

A+

 

[job75]

Cela dit en l'état la fonction Get_Tabmain est tout à fait inutile.

Et il faut tout afficher si un tableau est filtré, voyez ce fichier (2) :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Lobj As ListObject, TabMain As ListObject, P As Range, c As Range
    Application.EnableEvents = False
    On Error Resume Next
    For Each Lobj In Sh.ListObjects
        Lobj.Range.AutoFilter: Lobj.Range.AutoFilter 'si un tableau est filtré on affiche tout
    Next
    Set TabMain = Sh.Cells.Find("TabMain", , xlComments).ListObject
    Set P = TabMain.Range
    P.Rows(2).Resize(P.Rows.Count - 1).Delete xlUp 'RAZ
    For Each Lobj In Sh.ListObjects
        If Lobj.Name <> TabMain.Name Then
            Set c = P(1).EntireColumn.Find("", P(1), xlValues)
            c = Lobj.Name
            c(1, 2) = Lobj.Range.Rows.Count - 1
        End If
    Next
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Workbook_SheetActivate Sh
End Sub

 

[job75]

S'il y a d'autres lignes qui peuvent être masquées il sera bon de les afficher :

If Sh.FilterMode Then Sh.ShowAllData
Sh.Rows.Hidden = False