[VBA] - Correction de quelques erreurs persistantes (autofilter)

Bonsoir,

Le document Excel sur lequel j'ai travaillé ces derniers mois et où j'ai pu apprendre les bonnes bases du VBA grâce à vous est terminé et quasi-fonctionnel.

Pour fonctionner parfaitement, j'aimerais faire disparaître les dernières erreurs qui persistent et que je ne parviens pas à faire disparaître pour de bon (ou qui en créent d'autres quand j'essaie)

En pièce jointe, je vais ajouter le document en question, en ne laissant que le strict nécessaire pour faire apparaître les erreurs, histoire de pas se noyer dans les codes... En espérant que ça suffise.

Première erreur : Lorsque, dans la feuille "Correspondances", on renseigne, dans l'UF qui apparaît, une numéro d'étude comportant une lettre, alors, le tableau qui en résulte sera surmonté d'en-tête de colonnes avec les numéro des colonnes.

Je vous propose d'écrire :

• 9999 => Là, le tableau se créé avec les en-tête qu'il faut.
• 1234B => Là, il y a des en-tête qui ne sont pas bonnes.

"L'erreur" se créée dans le module "A01" ; il s'agit du sub structab()

Sub structab()
    Dim tb As ListObject

    Set co = Worksheets("Correspondances")

    With co
        If .ListObjects.Count Then
            .ListObjects(1).Name = "Correspondances"
        Else
        Set tb = .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion)
            tb.Name = "Correspondances"
        End If
    End With          
End Sub

Seconde erreur : Lorsque des données sont déjà présentes dans la feuille "Correspondances" et que l'on renseigne un autre numéro d'étude (dans l'UF), sans nettoyer, il est proposé de nettoyer automatiquement, si l'on clique sur non, alors une erreur apparaît : "La méthode AutoFilter de la classe Range a échoué."

Ça fonctionne pourtant à la première exécution du code, l'erreur vient peut-être du fait que les données sont déjà filtrées ?

Je vous propose d'écrire 1 fois 9999, de laisser le code s'exécuter, de revenir sur la feuille correspondances et de renseigner à nouveau 9999 ; l'erreur apparaîtra.

J'espère que mes explication son suffisamment claire, sinon je m’efforcerai de mieux expliquer.

J'ai créé un lien Cjoint pour mon document qui, "allégé" fait 14Mo

https://cjoint.com/c/IIbqDPwKaeh

Je vous remercie de votre attention,

Bonne fin de journée !

Bonjour,

Je ne sais pas comment mettre à jour ce code :

   'Conserver les valeurs recherchées (num étude)
    With co
    lrco = .Range("A" & Rows.Count).End(xlUp).Row
        .Rows(1).AutoFilter
        .Rows("1:" & lrco).AutoFilter Field:=2, Criteria1:="<>" & N, Operator:=xlAnd
        .Rows("2:" & lrco).Delete Shift:=xlUp
        .ShowAllData
    End With

Dans son fonctionnement, ce code doit permettre de supprimer toutes les lignes pour lesquelles la valeur indiquée en colonne 2 n'est pas identique à la variable N.

L'exécution du code fonctionne bien lorsqu'elle se fait la première fois. En revanche, si je demande à ce que les données déjà présentes dans le tableau soient conservées et que d'autre sont ajoutées, sur lesquelles (et uniquement celles-ci) je veux à nouveau exécuter ce code ; là j'ai une erreur... "La méthode AutoFilter de la classe Range a échoué".

En ce qui concerne l'erreur dans la création du tableau, cela doit provenir du fait que je fait référence, quelque part à une valeur numérique, laquelle devrait être une valeur variante ; mais je ne parviens pas à trouver l'origine du problème...

Je vous remercie de votre attention ; en espérant que vous ayez quelques réponses ; ou pistes !

Bonne journée !

Bonjour,

Première erreur "résolue" ; mais je ne sais pas comment...

J'ai modifié différents éléments pour optimiser l'exécution du code et résoudre des petits soucis que je n'avais pas remarqué.

Je n'ai plus fais attention à l'exécution de cette partie du code, jusqu'à ce jour, où je constate que l'erreur n'est plus !

C'est étrange.

Je suis convaincu qu'elle va réapparaître.

Bonsoir,

Un vrai monologue ce post haha !

Finalement, pour résoudre mon second problème, j'ai opté pour la création temporaire d'une feuille, où les données vont se retrouvées copiées le temps d'exécuter le reste du code sur une feuille nettoyée.

Une fois le code exécuté, les données sont rapatriées et la feuille temporaire est supprimée.

Je joins les deux codes ; l'un se place avant l'exécution de tous les modules pour sauvegarder les données, l'autre se place quasiment à la fin, avant la mise en forme du document.

Sub Gesttbl()

Sheets.Add(After:=Worksheets("Correspondances")).Name = "Corresp_temp"

Set co = Worksheets("Correspondances")
Set cotmp = Worksheets("Corresp_temp")

Sheets("Correspondances").Select

'Sauvegarder les données sur une autre feuille
lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
lcco = co.Range("A1").End(xlToRight).Column

lrcotmp = cotmp.Cells(Rows.Count, 1).End(xlUp).Row
'lccotmp = cotmp.Range("A1").End(xlToRight).Column

'Remplissage de la colonne [A] (Parrent row ID)
'Remplissage de la colonne [B] (numero_eture)
'Remplissage de la colonne [C] (espece)
'Remplissage de la colonne [D] (Correspondance)
'Remplissage de la colonne [E] (abondance)
'Remplissage de la colonne [F] (remarque)
'Remplissage de la colonne [G] (cortège)
'Remplissage de la colonne [H] (autres_infos)
'Remplissage de la colonne [I] (created_date)
'Remplissage de la colonne [J] (created_user)
'Remplissage de la colonne [K] (x)
'Remplissage de la colonne [L] (y)
'Remplissage de la colonne [M] (Identifiant unique)
    With co
        'dernière ligne non vide de la colonne A
        lrco = .Cells(.Rows.Count, 1).End(xlUp).Row
        'Plage à copier
        Set dt1 = .Cells(1, 1).Resize(lrco)
        Set dt2 = .Cells(1, 2).Resize(lrco)
        Set dt3 = .Cells(1, 3).Resize(lrco)
        Set dt4 = .Cells(1, 4).Resize(lrco)
        Set dt5 = .Cells(1, 5).Resize(lrco)
        Set dt6 = .Cells(1, 6).Resize(lrco)
        Set dt7 = .Cells(1, 7).Resize(lrco)
        Set dt8 = .Cells(1, 8).Resize(lrco)
        Set dt9 = .Cells(1, 9).Resize(lrco)
        Set dt10 = .Cells(1, 10).Resize(lrco)
        Set dt11 = .Cells(1, 11).Resize(lrco)
        Set dt12 = .Cells(1, 12).Resize(lrco)
        Set dt13 = .Cells(1, 13).Resize(lrco)
    End With

    With cotmp
        'dernière ligne non vide de la colonne A
        lrcotmp = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Loc1 = .Cells(lrcotmp, 1)
        Set Loc2 = .Cells(lrcotmp, 2)
        Set Loc3 = .Cells(lrcotmp, 3)
        Set Loc4 = .Cells(lrcotmp, 4)
        Set Loc5 = .Cells(lrcotmp, 5)
        Set Loc6 = .Cells(lrcotmp, 6)
        Set Loc7 = .Cells(lrcotmp, 7)
        Set Loc8 = .Cells(lrcotmp, 8)
        Set Loc9 = .Cells(lrcotmp, 9)
        Set Loc10 = .Cells(lrcotmp, 10)
        Set Loc11 = .Cells(lrcotmp, 11)
        Set Loc12 = .Cells(lrcotmp, 12)
        Set Loc13 = .Cells(lrcotmp, 13)
    End With

        dt1.Copy Destination:=Loc1
        dt2.Copy Destination:=Loc2
        dt3.Copy Destination:=Loc3
        dt4.Copy Destination:=Loc4
        dt5.Copy Destination:=Loc5
        dt6.Copy Destination:=Loc6
        dt7.Copy Destination:=Loc7
        dt8.Copy Destination:=Loc8
        dt9.Copy Destination:=Loc9
        dt10.Copy Destination:=Loc10
        dt11.Copy Destination:=Loc11
        dt12.Copy Destination:=Loc12
        dt13.Copy Destination:=Loc13

'Nettoyer la feuille
    co.Cells.ClearContents
    co.Cells.Interior.ColorIndex = xlColorIndexNone
End Sub

Sub RappatData()
Set co = Worksheets("Correspondances")
Set cotmp = Worksheets("Corresp_temp")

lrco = co.Cells(Rows.Count, 1).End(xlUp).Row
'lcco = co.Range("A1").End(xlToRight).Column
lrcotmp = cotmp.Cells(Rows.Count, 1).End(xlUp).Row
lccotmp = cotmp.Range("A1").End(xlToRight).Column

    With cotmp
        'Plage à copier
        Set dt1 = .Cells(2, 1).Resize(lrcotmp)
        Set dt2 = .Cells(2, 2).Resize(lrcotmp)
        Set dt3 = .Cells(2, 3).Resize(lrcotmp)
        Set dt4 = .Cells(2, 4).Resize(lrcotmp)
        Set dt5 = .Cells(2, 5).Resize(lrcotmp)
        Set dt6 = .Cells(2, 6).Resize(lrcotmp)
        Set dt7 = .Cells(2, 7).Resize(lrcotmp)
        Set dt8 = .Cells(2, 8).Resize(lrcotmp)
        Set dt9 = .Cells(2, 9).Resize(lrcotmp)
        Set dt10 = .Cells(2, 10).Resize(lrcotmp)
        Set dt11 = .Cells(2, 11).Resize(lrcotmp)
        Set dt12 = .Cells(2, 12).Resize(lrcotmp)
        Set dt13 = .Cells(2, 13).Resize(lrcotmp)
    End With

    With co
        'dernière ligne non vide de la colonne A
        lrco = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Loc1 = .Cells(lrco, 1)
        Set Loc2 = .Cells(lrco, 2)
        Set Loc3 = .Cells(lrco, 3)
        Set Loc4 = .Cells(lrco, 4)
        Set Loc5 = .Cells(lrco, 5)
        Set Loc6 = .Cells(lrco, 6)
        Set Loc7 = .Cells(lrco, 7)
        Set Loc8 = .Cells(lrco, 8)
        Set Loc9 = .Cells(lrco, 9)
        Set Loc10 = .Cells(lrco, 10)
        Set Loc11 = .Cells(lrco, 11)
        Set Loc12 = .Cells(lrco, 12)
        Set Loc13 = .Cells(lrco, 13)
    End With

        dt1.Copy Destination:=Loc1
        dt2.Copy Destination:=Loc2
        dt3.Copy Destination:=Loc3
        dt4.Copy Destination:=Loc4
        dt5.Copy Destination:=Loc5
        dt6.Copy Destination:=Loc6
        dt7.Copy Destination:=Loc7
        dt8.Copy Destination:=Loc8
        dt9.Copy Destination:=Loc9
        dt10.Copy Destination:=Loc10
        dt11.Copy Destination:=Loc11
        dt12.Copy Destination:=Loc12
        dt13.Copy Destination:=Loc13

Application.DisplayAlerts = False
    For Each tf In Sheets
        If tf.Name = "Corresp_temp" Then tf.Delete
    Next
Application.DisplayAlerts = True

End Sub

Sujet résolu !

Bonne soirée