problèmes de macro pour filtres avancés

C

christophedb

XLDnaute Nouveau
Bonjour à tous les membres,

J'ai des petite notions et suis souvent aidé par l'éditeur de macro.
Pour le travail , j'ai +/- 300 lignes de données que je dois exploiter en fonction de divers critères.
Ma base de données comprend 2 feuilles :
BD1 est la base de données principale :
les lignes sont modifiables, filtrées et/ou supprimée,
de nouvelles lignes peuvent être ajoutées
a chaque ajout ou retrait(s) de la BD1, un numéro est attribué et recalculé de 01 à XX
(cette partie fonctionne).

Je cale sur un tri et un copié:coller que je dois appliquer
je dois pouvoir :

- 1.sélectionner des données affichées en fonction de 3 filtres dans la BD1
- 2.le(s) copier/coller vers un autre feuille BD2
- 3.remettre les filtres à 0 dans BD1 pour afficher toute ma base de donnée
- 4.supprimer la sélection active du "copier/coller" dans BD1
- 5.détecter dans BD1 sur une colonne la présence de cellule vide, sélectionner la (les) lignes vides,
- 6.supprimer ces lignes vides de la base de données.
- 7.enfin renuméroter BD1 de 1 à XX

Rem : j'ai commenté en fonction de mon interprétation du code
Un bonne âme pour m'expliquer mes erreurs et me corriger
Merci

Code: 
Sub Bouton2_Cliquer()
' fonction filtre
' autorise un tri sur des colonnes déterminées au préalable
' selection de l'onglet BD1
Sheets("BD1").Select
' Active le filtre désiré
' filtre sur colonnes K, critères modifiables
 ActiveSheet.Range("$A$1:$R$300").AutoFilter Field:=11, Criteria1:= _
        "critere 1"
    ActiveSheet.Range("$A$1:$R$300").AutoFilter Field:=13, Criteria1:= _
        "critère 2"
    ActiveSheet.Range("$A$1:$R$300").AutoFilter Field:=17, Criteria1:= _
        "critère 3"
        ' le tri effectué
    ' dans BD1, copier uniquement les valeurs affichée par les filtres
    Sheets("BD1").Range("A2:R" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlVisible).Copy
    ' une foi copiée supprimer la selection
    Selection.EntireRow.Delete
    ' selection onglet BD2
    Sheets("BD2").Activate
    ' coller toutes les données dans l'onglet travail
    ' en vérifiant qu'il n'y ai deja pas des données inscrites
    ' eviter les cellules vides et ne pas écraser les données
    ' les inscrires à la suite ...
    ActiveCell.SpecialCells(xlLastCell).Activate
    Cells(ActiveCell.Row + 1, 1).Activate
    Selection.PasteSpecial Paste:=xlValues, Transpose:=False
    Application.CutCopyMode = False
    ' selection onglet BD1
    ' remettre les filtres initiaux
    ' selectionner toutes les cellules vides de la colonne A
    Sheets("BD1").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveSheet.Range("$A$1:$R$300").AutoFilter Field:=17
    ActiveSheet.Range("$A$1:$R$300").AutoFilter Field:=13
    ActiveSheet.Range("$A$1:$R$300").AutoFilter Field:=11
    Columns("A2:A" & Range("A65536").End(xlUp).Row + 1).Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    ' pour effacer les lignes correpondantes
    Selection.EntireRow.Delete
    ' renuméroter enfin ma première colonne de BD1 pour actualiser les données
    With Sheets("BD1")
        NUMDEM = .Cells(Rows.Count, "A").End(xlUp).Row
                .Range("A3:A4").AutoFill .Range("A3:A" & NUMDEM)
    End With
    End Sub
End Sub

lorsque je lance le prog : il m'indique l'erreur 1004 :
La méthode PasteSpeciale de la classe Range à échoué ... ??
ca me renvoie sur :
Selection.PasteSpecial Paste:=xlValues, Transpose:=False
 

Pièces jointes

  • tri.xlsm
    64.1 KB · Affichages: 50
  • tri.xlsm
    64.1 KB · Affichages: 61
  • tri.xlsm
    64.1 KB · Affichages: 54
Dernière édition:
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : problèmes de macro pour filtres avancés

Bonsoir Christophe, bonsoir le forum,

Tu sélectionnes, copies et ensuite tu effaces avant de coller. Donc tu vides le presse-papier et tu ne peux plus coller... Ci-dessous ton code modifié (si j'ai bien compris...) :
Code: 
Private Sub cmdMAJ_Click()
Dim O1 As Object
Dim O2 As Object
Dim PL As Range
Dim PLV As Range
Dim DEST As Range

Set O1 = Sheets("BD1")
Set O2 = Sheets("BD2")
Set PL = O1.Range("A2:R" & O1.Cells(Application.Rows.Count, 1).End(xlUp).Row)
O1.Range("A1").AutoFilter Field:=5, Criteria1:="Poste test"
O1.Range("A1").AutoFilter Field:=6, Criteria1:="Poste oui"
O1.Range("A1").AutoFilter Field:=8, Criteria1:="ob0"
Set PLV = PL.SpecialCells(xlCellTypeVisible)
PLV.Copy
Set DEST = O2.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
DEST.PasteSpecial Paste:=xlValues, Transpose:=False
PLV.EntireRow.Delete
O1.Range("A1").AutoFilter
O1.Range("A2:A" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
NUMDEM = O1.Cells(Application.Rows.Count, 1).End(xlUp).Row
O1.Range("A3:A4").AutoFill O1.Range("A3:A" & NUMDEM)
End Sub
 
Vote positif 0 Vote négatif
C

christophedb

XLDnaute Nouveau
Re : problèmes de macro pour filtres avancés

RE,

Je viens de tester cela fonctionne !
c'est super merci,
et je viens de me rendre compte de mon erreur ...

par contre si je veux rajouter une condition : verifier qu'il y ai bien une plage de cellule filtrée, car si il n'y a pas de plage de cellule , Excel me renvoie une erreur ....

- si cellule filtrée présente alors je continue sinon j'affiche un message et je retourne sur l'userform,

mille merci
 
Dernière édition:
Vote positif 0 Vote négatif
C

christophedb

XLDnaute Nouveau
Re : problèmes de macro pour filtres avancés

Pas d'idée pour le test de vérification si il y a bien des cellules sélectionnées ?
je bloque sur la condition a utiliser ....
le code fonctionne a conditions d'avoir une selection, si il n'y en a pas alors le programme renvoie une erreur, ce qui est logique.
il me semble qu'un simple if thn else sur la valeur de la variable PLV .
Si je fais if PLV<>"" then .... instructions else ..... boucler sur l'userform ( load me ??? ) cela me renvoie une erreur ...
une correction serait merveilleuse ...

et O1 = Sheets("BD1")
Set O2 = Sheets("BD2")
Set PL = O1.Range("A2:R" & O1.Cells(Application.Rows.Count, 1).End(xlUp).Row)
O1.Range("A1").AutoFilter Field:=5, Criteria1:="Poste test"
O1.Range("A1").AutoFilter Field:=6, Criteria1:="Poste oui"
O1.Range("A1").AutoFilter Field:=8, Criteria1:="ob0"
Set PLV = PL.SpecialCells(xlCellTypeVisible)
PLV.Copy
Set DEST = O2.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
DEST.PasteSpecial Paste:=xlValues, Transpose:=False
PLV.EntireRow.Delete
O1.Range("A1").AutoFilter
O1.Range("A2:A" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
NUMDEM = O1.Cells(Application.Rows.Count, 1).End(xlUp).Row
O1.Range("A3:A4").AutoFill O1.Range("A3:A" & NUMDEM)
End Sub
 
Vote positif 0 Vote négatif
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : problèmes de macro pour filtres avancés

Bonsoir Christophe, bonsoir le forum,

Essaie comme ça :
Code: 
Private Sub cmdMAJ_Click()
Dim O1 As Object
Dim O2 As Object
Dim PL As Range
Dim PLV As Range
Dim DEST As Range

Set O1 = Sheets("BD1")
Set O2 = Sheets("BD2")
Set PL = O1.Range("A2:R" & O1.Cells(Application.Rows.Count, 1).End(xlUp).Row)
O1.Range("A1").AutoFilter Field:=5, Criteria1:="Poste test"
O1.Range("A1").AutoFilter Field:=6, Criteria1:="Poste oui"
O1.Range("A1").AutoFilter Field:=8, Criteria1:="ob0"
On Error Resume Next
Set PLV = PL.SpecialCells(xlCellTypeVisible)
If Err <> 0 Then
    Err.Clear
    O1.Range("A1").AutoFilter
    MsgBox "Aucune donnée filtrée !"
    Exit Sub
End If
On Error GoTo 0
PLV.Copy
Set DEST = O2.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
DEST.PasteSpecial Paste:=xlValues, Transpose:=False
PLV.EntireRow.Delete
O1.Range("A1").AutoFilter
O1.Range("A2:A" & Range("A65536").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
NUMDEM = O1.Cells(Application.Rows.Count, 1).End(xlUp).Row
O1.Range("A3:A4").AutoFill O1.Range("A3:A" & NUMDEM)
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2019 AutoFiltre et zone de données
Réponses
5
Affichages
253
Flx1er
F
P
  • Question
Microsoft 365 problème de filtre avec une checkbox
2
Réponses
18
Affichages
589
ChTi160
ChTi160
L
  • Résolu(e)
Microsoft 365 Trie par Date & Heure
Réponses
8
Affichages
374
Le Rouky
L
Usine à gaz
  • Résolu(e)
XL 2021 Filtrage que je ne parviens pas à faire
Réponses
6
Affichages
539
Usine à gaz
Usine à gaz
O
  • Question
Microsoft 365 Tri filtre contextuel ne fonctionnant pas après l'enregistrement d'une Macro
Réponses
5
Affichages
345
sylvanu
sylvanu
L
  • Question
Microsoft 365 Faire agir une macro en fonction de l'emplacement du bouton
Réponses
2
Affichages
296
AtTheOne
AtTheOne
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
448
candido57
C
C
  • Résolu(e)
XL 2016 Répartir dans des Groupes d'Effectifs Aléatoires ... mais pas trop
Réponses
2
Affichages
220
crocrocro
C
E
  • Question
XL 2013 Code VBA
Réponses
12
Affichages
811
eutrophisation
E
Z
  • Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
237
zendb
Z

Membres actuellement en ligne

16 membres et 127 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 647
Messages
2 111 531
Membres
111 191
dernier inscrit
Assjmka