XL 2016 Erreur 1004 > Filtre + Copie données

[Buk]

Bonsoir,

Je vous sollicite pour une erreur qui m'occupe depuis hier.
Je traite un dossier avec une base de données à partir de laquelle je veux extraire les infos vers une autre feuille selon un critère (ici la zone en colonne B).

Via une macro initialement créée par un enregistrement (donc pas optimisé ) et modifiée ensuite, je rencontre une erreur1004 récurrente.
Pour éviter tout oubli,
Je désactive les filtres sur toutes les colonnes de la feuille Base de données et Drop A dans le cas présent
Je supprime le contenu de la feuille Drop A
Je filtre dans la feuille Base de données via le critère voulu (ici Drop A)
Je copie mes données puis les collent dans la feuille Drop A

Ca c'est ce que je veux faire, malheureusement ma macro bloque (erreur 1004) à la dernière ligne montrée ci-dessous.
J'ai essayé en faisant sauté ces filtres, mais la macro bloque ensuite à la ligne de collage des données dans la feuille Drop A.

Je retourné ça dans tous les sens, pas moyen de corriger la macro.
D'autant que le même code fonctionne pour la feuille Base de données. Je pense avoir un soucis dans la définition de ma variable TABCopie...

Ci-dessous la macro où j'ai l'erreur et le fichier objet de mes maux de tête

Sub Drop_A()

    Application.ScreenUpdating = False 'Désactive la mise à jour à l'écran
    ActiveWorkbook.Save 'Enregistre le fichier
    
    Call Initialisation_Variables 'Appelle la Macro d'initialisation des variables
    
    FEUILLE = "Drop A"
    
    Sheets(FEUILLE).Activate 'Active la feuille
    
    TABCopie = "$A25:$I$" & DerLigne 'Détermine le tableau par poste
    
'Désactivation des filtres
    ActiveSheet.Range(TABCopie).AutoFilter Field:=REP
    ActiveSheet.Range(TABCopie).AutoFilter Field:=ZONE
    ActiveSheet.Range(TABCopie).AutoFilter Field:=PC
    ActiveSheet.Range(TABCopie).AutoFilter Field:=LOC
    ActiveSheet.Range(TABCopie).AutoFilter Field:=ENV
    ActiveSheet.Range(TABCopie).AutoFilter Field:=INTER
    ActiveSheet.Range(TABCopie).AutoFilter Field:=ALERTE
    ActiveSheet.Range(TABCopie).AutoFilter Field:=VUE
    ActiveSheet.Range(TABCopie).AutoFilter Field:=COM
          
    Rows("25:" & DerLigne).ClearContents 'Supprime le contenu des lignes
    
    Sheets("Base de données").Activate
    ActiveSheet.Range(TABDonnees).AutoFilter Field:=ZONE, Criteria1:=FEUILLE 'Filtre les affaires en chiffrage
    Rows("2:" & DerLigne).Copy 'Copie les affaires filtrées
    ActiveSheet.Range(TABDonnees).AutoFilter Field:=ZONE 'Désactive le filtre la colonne
    
    Sheets(FEUILLE).Activate
    Range("A25").Select
    ActiveSheet.Paste 'Colle les affaires copiées
    Range("F23").Select
    ActiveSheet.Range(TABCopie).AutoFilter Field:=ZONE
    
End Sub

Merci de vos retours

 

[Staple1600]

Bonsoir le fil


Si il s'agit de faire ce que fait le code ci-dessous

Sub Macro1()
With ActiveSheet.ListObjects("Tableau1")
    .Range.AutoFilter Field:=2, Criteria1:="Drop A"
    .DataBodyRange.Copy
End With
Range("Tableau4").End(xlDown).Offset(1).PasteSpecial xlPasteValues
End Sub

Alors il le fait, et pas d'Erreur 1004 constatée pour le moment.
(test OK sur ton fichier)

 

[Buk]

Bonjour,

J'ai testé le code, la finalité, c'est bel et bien ça.

Mon problème se situe en amont lorsque je souhaite retirer les éventuels filtres appliqués sur le tableau de la feuille Drop A
Soit cette ligne ci > ActiveSheet.Range(TABCopie).AutoFilter Field:=REP

J'ai donc essayé de retirer ces lignes qui plantées pour tester tout le reste, et j'ai ensuite eu une erreur sur cette ligne
> ActiveSheet.Paste 'Colle les affaires copiées

Est-ce que le fait d'avoir un tableau qui débute à la ligne 25 peut être source de problème ?

Pour finir, quelques questions sur le code proposé ci-dessus
- Le DataBodyRange.Copy permet de copier le résultat du filtre ?
- Le End(xlDown) permet de trouver la dernière ligne non vide en partant du bas ?
- Le OffSet permet de faire un décalage de 1 ligne par rapport au résultat du End(xlDown) ?

 

[Staple1600]

Bonjour le fil

Buk
Tu as auto-répondu aux questions
C'est bien, cela me permets de m'économiser
Tous ces mot en gras dans ton message ne sont pas hydrophobes, nomophobes ou g..glophobes
(Donc un petit clic-droit dans le browser-> Rechercher avec le moteur par défaut )

Pour le reste ta question, pourquoi utiliser le VBA quand les fonctionnalités natives d'Excel permettent de s'en passer?
(Ici je pense au Filtre avancé qui permet la recopie des données filtrées sur une autre feuille)

 

[Buk]

Ne connaissant pas du tout le filtre avancé et les possibilités qu'il offre, et ayant déjà une macro qui dégrossissait ce que je voulais faire, j'ai foncé tête baissée

Vu que je prévois d'échanger ce fichier avec un client, me passer des macros m'arrangeraient bien.
Je vais regarder les filtres avancées de plus près !

Merci de ton aide

 

[Staple1600]

Re

[suggestion d'avant le quart]
Je conseille de devenir adepte du principe K.I.S.S

[/suggestion d'avant le quart]

 

[Staple1600]

Re

Voici un petit exemple
1) Dans un classeur vierge avec une seule feuille nommée Feuil1
copier le code VBA suivant

Sub Creer_Test()
Dim f As Worksheet, t: t = Array("ITEM_1", "ITEM_2", "Drops", "ITEM_4", "ITEM_5")
Set f = Sheets.Add(after:=Sheets(Sheets.Count))
f.Name = "Feuil2": f.[A1:E1] = t: f.[G1] = "Drops": f.[G2] = "DropA"
Sheets("Feuil1").Activate: [A1:E1] = t
[A2:E27] = "=ADDRESS(ROW(),COLUMN(),4)": [C3,C8,C12,C15:C17,C23:C25] = "DropA"
[A1].CurrentRegion = [A1].CurrentRegion.Value
Sheets("Feuil1").ListObjects.Add(xlSrcRange, Range("$A$1:$E$27"), , xlYes).Name = "Tablo"
f.Activate
End Sub

Désormais , vous devez avoir deux feuilles et être sur la feuille Feuil2
2) Copiez cette autre macro

Sub Filtre_Avancé()
Sheets("Feuil1").Range("Tablo[#All]").AdvancedFilter _
        Action:=xlFilterCopy, _
        CriteriaRange:=Range("Feuil2!G1:G2"), _
        CopyToRange:=Sheets("Feuil2").Range("A1:E1"), Unique:=False
End Sub

Et retourner sur la feuille Feuil2
Lancer alors la macro Filtre_Avancé

NB: Cette macro est donc la transcription VBA de la manipulation pilotée à la souris: Données/Filtrer/Avancé/ [x] Copier vers un autre emplacement.

 

[Buk]

Re,

L'ironie dans votre précédent message, c'est que je suis un fervent défenseur de ce principe dans la conception mécanique que je pratique tous les jours...

Quoi qu'il en soit, les filtres avancés, ça fait le job !
Et vu que je ne suis pas de nature à ne pas comprendre ce qu'il se passe, j'ai épluché mon code pour me rendre compte que tout allez bien et que j'avais un conflit entre la définition de mon tableau sur la feuille "Drop A" et celle que je faisais dans mon code

Résultat les deux solutions fonctionnent et je vais analyser la troisième que tu m'as donné.

Un grand merci pour le dépannage et le temps passé.
Bon week-end