filtre avec vide et 1 seul critére a

[a10]

Bonjour,

Voici ma macro qui copie avec un filtre
j'ai pris l'option de retirer les vides et je ne prends que les a ( je n'ai que des vides ou que des a)

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

Sheets("H").Select

Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("dons").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Range("$D$1:$BA$512").AutoFilter Field:=18


=> mais comment faire si on a que des vides et donc pas de a

je recherche cela depuis plusieurs semaine sans résultats

merci

a+

 

[Staple1600]

Re : filtre avec vide et 1 seul critére a

Bonjour à tous

a10
Pourquoi un autre fil?
Un petit up dans le fil initial
https://www.excel-downloads.com/threads/macro-pur-faire-un-filtre.218394/
pouvait suffire, non ?

Pour ne filtrer que les cellules vides (syntaxe issue de l’enregistreur de macros)

Selection.AutoFilter
 ActiveSheet.Range("$A$1:$A$11").AutoFilter Field:=1, Criteria1:="="

A adapter à tes besoins.

 

[a10]

Re : filtre avec vide et 1 seul critére a

bonjour

le premier post je n'ai pas fonctionné dans mon problème j' ai reposé des questions afin de continuer.

Mais dans ce post je veux tous sauf les vides.

et quand il y que des vides ma macro copie tout.

voila mon problème que je suis en train de resoudre.

a+

 

[Staple1600]

Re : filtre avec vide et 1 seul critére a

Re


Chez moi, avec cette syntaxe, j'ai tout sauf les vides ...
ActiveSheet.Range("$A$1:$A$11").AutoFilter Field:=1, Criteria1:="<>"

PS: Inscrit depuis 2009, tu devrais savoir qu'il manque quelque chose dans ta discussion, non ?

 

[MJ13]

Re : filtre avec vide et 1 seul critére a

Bonjour A10, Jean-Marie

C'est vrai que sans fichier, c'est difficile de comprendre et de pouvoir tester.

Sinon, dès que j'ai un feuille filtrée et que je veux copier l'ensemble de la feuille avec sa structure en terme de largeur de colonne et de ligne, j'utilise cette macro 🙂. Et je n'ai plus de problèmes de ralentissement parce qu'Excel essaie de copier toutes les cellules sur 1 millions de lignes 😱.

Sub Copie_Structure_Feuille_Valeur_Format_Commentaire()
'Dim t1 As Long, NomFAct As String, DerCelSel As Variant, DerCelAdr As Variant, NBcol As Long, NBLig As Long, cell As Range, i As Long
    Dim LargCol(1048576), HautLig(1048576)    ', DercelLig As Long, DerCelCol As Long, Ilig As Long, ICOl As Long
 If [A1].SpecialCells(xlLastCell).Address = "$A$1" And [A1] = "" Then Exit Sub
    t1 = Timer

    Application.ScreenUpdating = False
    NomFAct = ActiveSheet.Name


    'DerCelSel = ActiveCell.SpecialCells(xlLastCell).Select
    'DerCelAdr = ActiveCell.Address
    'DercelCol = ActiveCell.Column
    'DercelLig = ActiveCell.Row
    'Attenton si bug avec des feuille vide mais à la fin à 1 milllions de ligne.Voir avec les paramètres suivant:
    
   'If DercelLig > 1000 Then DercelLig = 65000
   'If DercelCol > 1000 Then DercelCol = 65000
   'MsgBox Cells.Find("*", [A1], , , 1, 2).Row
   DercelLig = Cells.Find("*", [A1], , , 1, 2).Row
   DercelCol = Cells.Find("*", [A1], , , 1, 2).Column
   
    NBcol = 0
    For ICOl = 1 To DercelCol
        If Cells(1, ICOl).ColumnWidth <> 0 Then NBcol = NBcol + 1: LargCol(NBcol) = Cells(1, ICOl).ColumnWidth
    Next
    
    
    NBLig = 0
    For Ilig = 1 To DercelLig
        If Rows(Ilig & ":" & Ilig).RowHeight <> 0 Then NBLig = NBLig + 1: HautLig(NBLig) = ActiveSheet.Rows(Ilig & ":" & Ilig).RowHeight
    Next
    'Stop
    ' A voir pour traitement de type Tableau
    'For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(DercelLig, DerCelCol))
        'Traitement tableau
    'Next

    Sheets.Add
    For i = 1 To NBcol
        Cells(1, i).ColumnWidth = LargCol(i)
    Next
    For i = 1 To NBLig
        Rows(i & ":" & i).RowHeight = HautLig(i)
    Next

    ActiveSheet.Next.Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    ActiveSheet.Previous.Select
    Range("A1").Select
    
    'Mettre pour chaque cellule la valeur et le format et le commentaire
    'Posibilité de mettre la formule avec xlPasteFormulas mais commenter xlPasteValues
    'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
     
     'Copie la valeur
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
     'Copie le Format
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
    'Copie les Commentaires
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
                           On Error Resume Next 'au cas ou le nom de l'onglet existe
        If Len(NomFAct) < 27 Then ActiveSheet.Name = "CV " & Replace(NomFAct, " ", "") Else ActiveSheet.Name = "CV " & Replace(Mid(NomFAct, 1, 14), " ", "") & Replace(Right(NomFAct, 14), " ", "")
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True


    'MsgBox Timer - t1
    Application.StatusBar = Format(Timer - t1, "0.0") & " secondes"
End Sub

 

[a10]

Re : filtre avec vide et 1 seul critére a

bonjour Staple 600


c'est vrai cela fonctionne

mais le problème est que lorsque il n'y a que des vides il copie tout

et moi je voudrai que si il n'a pas de critère = a
il ne copie pas

a+

 

[MJ13]

Re : filtre avec vide et 1 seul critére a

Re

C'est vrai que c'est de moins en moins clair. Sans fichier, c'est pas possible de comprendre (enfin pour moi 😱).

Alors A10, fait un effort.

Attendons le fichier exemple (comme de plus en plus souvent ces temps-ci sur XLD)

Et, oui, Jean-Marie, c'est la mode 😀.

 

[Staple1600]

Re : filtre avec vide et 1 seul critére a

Re

MJ13
Avec ceci, tu vas "perplexifé" a10 😉
If Len(NomFAct) < 27 Then ActiveSheet.Name = "CV " & Replace(NomFAct, " ", "")Else ActiveSheet.Name = "CV " & Replace(Mid(NomFAct, 1, 14), " ", "") & Replace(Right(NomFAct, 14), " ", "")
(car pas sur que cela concerne son fichier 😉 )

Attendons le fichier exemple (comme de plus en plus souvent ces temps-ci sur XLD)

 

[a10]

Re : filtre avec vide et 1 seul critére a

bonjour,

stop je vous fait un fichier en debut d'apres midi.

je ne comprends plus rien.


Je refait un fichier

mais pour info:

voici ma problèmatique:

lorsque le filtre il y a que des vides il copie tout

et moi je voudrai que si il n'a pas de critère = a
il ne copie pas

a+

 

[Staple1600]

Re : filtre avec vide et 1 seul critére a

Re

a10
Il faut moins d'un quart d'heure pour faire un fichier exemple qui contient des a et du vide.

 

[a10]

Re : filtre avec vide et 1 seul critére a

bonjour

cela m'enerve car dans le fichier d'exemple que je fais cela marche et pas dans mon gros fichier.

Je suis assez enervé....

a+

 

[a10]

Re : filtre avec vide et 1 seul critére a

bonjour

je pense avoir trouve la cause car j'avais un filtre dans la colonne avant

as ton une solution pour eviter ce problème?

a+

 

[Staple1600]

Re : filtre avec vide et 1 seul critére a

Re

a10
Ton fichier exemple faisant 573 Ko ( ! ), on devrait s'attendre à qu'il soit suffisamment explicite pour illustrer ton problème !
Or tu nous disais vouloir filtrer avec le critère =a
(or point de a dans ton fichier!)


Prends le temps de concocter un fichier plus léger et plus explicite et ajoute les explications et détails nécessaires pour qu'on comprenne au mieux ta question.

 

[a10]

Re : filtre avec vide et 1 seul critére a

Bonjour

c'est ma problématique:

quand il n'y a pas de critére a, il copie tout dans l'autre feuille

clique sur le bouton bleu pour voir le resultat

il doit seulment copier que des critere s a

a+

 

[Staple1600]

Re : filtre avec vide et 1 seul critére a

Re


Essaie ceci alors

Sub Macro10()
Dim pf As Range
    With ActiveSheet
        .Range("$N$1:$Q$7").AutoFilter Field:=1, Criteria1:="<>"
        Set pf = .[_FilterDatabase]
         pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Sheets("copie").Range("A1")
         .AutoFilterMode = False
    End With
End Sub