[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