macro pur faire un filtre

[a10]

bonjour

j'ai une macro qui copie les lignes qui ont un "A"

Range("E2:X512").Select
ActiveSheet.Range("$D$1:$BA$512").AutoFilter Field:=18, Criteria1:="<>"
Selection.Copy

mais quand il n'y pas de A il copie tout le tableau

quand il y a au moins un a la macro fonctionne


A+

 

[Lone-wolf]

Re : macro pur faire un filtre

Bonjour a10,

et si tu met criteria1:="A", qu'est-ce que ça donne?



A+ 😎

 

[a10]

Re : macro pur faire un filtre

bonjour,

j'ai essayé mais cele fait la meme chose.

j'ai le meme problème en inscrivant "A"

a+

 

[xhudi69]

Re : macro pur faire un filtre

Bonjour a10, le Forum,
Bonjour Lone-wolf 🙂

Avec un fichier exemple se serait mieux (après + de 300 posts...........)
merci 😛

@+ 😎

 

[a10]

Re : macro pur faire un filtre

bonjour

voici le ficvhier::

a+

 

[xhudi69]

Re : macro pur faire un filtre

Bonjour a10, le Forum,

Avec ceci cela doit fonctionner:

ActiveSheet.Range("$A$1:$B$5").AutoFilter Field:=2, Criteria1:="a"

mais je ne vois pas où tu veux en venir 😕

@+😎

 

[xhudi69]

Re : macro pur faire un filtre

Bonjour a10

ce serait mieux comme cela:

Sub TriCopie()
Dim Drl As Integer, Drl2 As Integer, i As Integer
Set f = Sheets("Feuil1")
Set g = Sheets("copie")

Drl = f.Range("B65500").End(xlUp).Row
For i = 2 To Drl
    If f.Cells(i, 2).Value = "a" Then
        Drl2 = g.Range("A65500").End(xlUp).Row + 1
        g.Range("A" & Drl2).Value = f.Cells(i, 1).Value
        g.Range("B" & Drl2).Value = f.Cells(i, 2).Value
    End If
Next i
End Sub

@+ 😎

 

[xhudi69]

Re : macro pur faire un filtre

Bonjour a10, le Forum,

En PJ ton fichier remanié.

@+ 😎

 

[Lone-wolf]

Re : macro pur faire un filtre

Bonsoir xhudi69, a10

Code à insérer dans Feuil1. Tabeau1 est le nom de la plage de cellules "a2:b65536"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect(Target, [Tableau1]) Is Nothing Then
Range("Tableau1").AutoFilter Field:=2, Criteria1:=Target.Text, _
Visibledropdown:=True
End If
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.ScreenUpdating = False
On Error Resume Next
If Not Intersect(Target, [Tableau1]) Is Nothing Then
ActiveSheet.ShowAllData
End If
End Sub

Et dans le code du bouton

Sub Macro1()
Sheets("Feuil1").Range("a2:b65536").SpecialCells(xlCellTypeVisible).Copy Sheets("copie").Range("a2")
End Sub

Voir pièce jointe.

A+ 😎

 

[a10]

Re : macro pur faire un filtre

bonjour

avec cette macro cela semble fonctionner mais comment faire pour supprimer les lignes ( de la première feuille) quand elles ont été copiées

a+

 

[Lone-wolf]

Re : macro pur faire un filtre

Bonjour a10,


Regarde si sa te convient.


A+ 😎

 

[a10]

Re : macro pur faire un filtre

BOSOIR

ActiveSheet.Range("$D$1:$BC$512").AutoFilter Field:=21, Criteria1:="A"

POURQUOI QUAND IL N'Y A PAS DE A; il prends tout le tableau ?

a+

 

[Lone-wolf]

Re : macro pur faire un filtre

Bonsoir a10

As-tu pris le soin de regarder le dernier classeur??

POURQUOI QUAND IL N'Y A PAS DE A; il prends tout le tableau ?

Essaie comme ceci : If ActiveSheet.Range("$D$1:$BC$512").value <> "A" Then Exit sub

ET POURQUOI TU AS MIS .AutoFilter Field:=21???

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("c1:x65536")) Is Nothing Then Exit Sub
On Error Resume Next
If Not Intersect(Target, [Tableau1]) Is Nothing Then
' Ici la macro trie d'après la colonne choisie et la valeur de la cellule active.
Range("Tableau1").AutoFilter Field:=Target.Column, Criteria1:=Target.Text, _
Visibledropdown:=True
If Target.Text = "" Then: MsgBox "Il n'y a plus de données dans le Tableau", , "Tableau": Exit Sub
End If
End Sub

A+ 😎

 

[a10]

Re : macro pur faire un filtre

bonjour,

j'ai mis .AutoFilter Field:=21???

car c'est la deuxième colonne (erreur j'aurai du mettre 2 au lieu de 21)

a+

 

[Lone-wolf]

Re : macro pur faire un filtre

Bonjour a10,

avec le dernier fichier que j'ai, mis copie cette macro.

J'ai modifié la ligne affichant le MsgBox, pour éviter de filtrer si le tabeau ne contient pas de A.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lettre As String
Application.ScreenUpdating = False
If Not Intersect(Target, Range("c1:x65536")) Is Nothing Then Exit Sub
On Error Resume Next
lettre = "a"
If Not Intersect(Target, [Tableau1]) Is Nothing Then
Range("Tableau1").AutoFilter Field:=Target.Column, Criteria1:=Target.Text, _
Visibledropdown:=True
If Target.Text <> "a" Then: MsgBox "Vous devez sélectionner la lettre " & lettre & " dans le Tableau", , "Tableau": ActiveSheet.ShowAllData: Exit Sub
End If
End Sub

A+ 😎