Microsoft 365 Code pour tri avec critère

[Marvin57]

Bonjour à tout le monde,

dans mon fichier ci-joint je peux faire un tri en appuyant le bouton de l'onglet ACCUEIL.

Ce tri se fait sur l'onglet Feuil1 colonne Comptage.
D'après mon petit code il doit me faire un tri de toutes les lignes du tableau qui ont le chiffre 1 en colonne K et m'afficher ce tri sur l'onglet Feuil2.

Jusqu'ici cela fonctionne, enfin d'après mes premiers test.

Mais, si je clique sur le bouton et que aucun 1 se trouve dans la colonne K, il m'affiche le tableau complet sur l'onglet Feuil2.

Pourriez-vous me guider S'il vous plaît pour modifier ce code afin que l'action du bouton fonctionne uniquement si dans la colonne K se trouve un ou plusieurs 1.

Merci d'avance à vous pour votre aide.

Marvin57

 

[vgendron]

Bonjour

tu confonds tri et filtre
ta macro fait un FILTRE

ensuite, quand tu fais la copie.. tu copies TOUTE la table, quelle soit filtrée ou pas

essaie cette macro

Sub AFFICHERALERTESQTE() 'AFFICHER LES ALERTES QUANTITES
    Application.ScreenUpdating = False
    'On Error Resume Next 'Supprimer cette ligne car elle empeche de voir les bugs potentiels du code
    Set ws = Sheets("Feuil1")
    Set wd = Sheets("Feuil2")
    With wd.ListObjects(1)
        If .ListRows.Count <> 0 Then
            .DataBodyRange.ClearContents  'avec la table de la feuille wd, on vide le databodyrange
        End If
        .Resize wd.Range("A1:K2") 'on redimensionne la table avec juste une ligne d'entete + une ligne de données (vide)
    End With


    With ws.ListObjects(1)
        .Range.AutoFilter field:=11, Criteria1:=1 'on filtre sur la colonne 11 = K
        .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=wd.ListObjects(1).DataBodyRange
    End With
    ws.ListObjects("Tableau1").Range.AutoFilter 'on supprime les filtre
 
End Sub

 

[fanfan38]

Bonjour (Salut Vgendron)
Moi j'ai préféré copier le tableau 1 et ensuite le filtrer...

A+ François

 

[Marvin57]

Bonjour

tu confonds tri et filtre
ta macro fait un FILTRE

ensuite, quand tu fais la copie.. tu copies TOUTE la table, quelle soit filtrée ou pas

essaie cette macro

Sub AFFICHERALERTESQTE() 'AFFICHER LES ALERTES QUANTITES
    Application.ScreenUpdating = False
    'On Error Resume Next 'Supprimer cette ligne car elle empeche de voir les bugs potentiels du code
    Set ws = Sheets("Feuil1")
    Set wd = Sheets("Feuil2")
    With wd.ListObjects(1)
        If .ListRows.Count <> 0 Then
            .DataBodyRange.ClearContents  'avec la table de la feuille wd, on vide le databodyrange
        End If
        .Resize wd.Range("A1:K2") 'on redimensionne la table avec juste une ligne d'entete + une ligne de données (vide)
    End With


    With ws.ListObjects(1)
        .Range.AutoFilter field:=11, Criteria1:=1 'on filtre sur la colonne 11 = K
        .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=wd.ListObjects(1).DataBodyRange
    End With
    ws.ListObjects("Tableau1").Range.AutoFilter 'on supprime les filtre
 
End Sub

Bonjour vgendron,

Merci pour le retour.

Mais il me donne une erreur si je place votre code dans mon fichier. Voir image jointe

 

[Marvin57]

Bonjour (Salut Vgendron)
Moi j'ai préféré copier le tableau 1 et ensuite le filtrer...

A+ François

Bonjour fanfan38,

Merci également pour votre aide à ma demande. Cela fonctionne très bien, donc je vais faire des essais tout à l'heure.
A+

Marvin57

 

[vgendron]

Bonjour vgendron,

Merci pour le retour.

Mais il me donne une erreur si je place votre code dans mon fichier. Voir image jointe
Regarde la pièce jointe 1176836

l'erreur n'intervient elle pas lorsque le filtre ne donne aucune ligne??
dans ce cas, il faut ajouter un test pour voir s'il y a bien au moins une ligne à copier
avec un truc du genre
if .databodyrange.specialcells..... .count<>0 (à tester)

 

[Marvin57]

l'erreur n'intervient elle pas lorsque le filtre ne donne aucune ligne??
dans ce cas, il faut ajouter un test pour voir s'il y a bien au moins une ligne à copier
avec un truc du genre
if .databodyrange.specialcells..... .count<>0 (à tester)

Re,

je comprends ce que vous voulez dire avec

....avec un truc du genre
if .databodyrange.specialcells..... .count<>0 (à tester)

et le placer ou ?

 

[vgendron]

juste avant la ligne qui "bug" surlignée en jaune
if test then
ligne qui bug
end if

 

[Marvin57]

juste avant la ligne qui "bug" surlignée en jaune
if test then
ligne qui bug
end if

il ne se passe rien

 

[vgendron]

HAHAHA !!
Test.....

 

[Marvin57]

HAHAHA !!
Test.....

Désolé mais je ne vois pas .....

 

[vgendron]

il faut ecrire le test ! pas juste recopier le mot test
if .databodyrange......

 

[Marvin57]

il faut ecrire le test ! pas juste recopier le mot test
if .databodyrange......

comme cela ?
if .DataBodyRange.SpecialCells(xlCellTypeVisible).Copy Destination:=wd.ListObjects(1).DataBodyRange then
End If

 

[vgendron]

euh...
quand tu écris

je comprends ce que vous voulez dire avec

....avec un truc du genre
if .databodyrange.specialcells..... .count<>0 (à tester)

en fait, tu ne comprends pas...

 

[Marvin57]

euh...
quand tu écris


en fait, tu ne comprends pas...

oui, désolé pour la détente longue (le lundi).

Merci je vais essayé cela dans mon fichier réel ce soir et je reviendrai vers vous.

Merci en tout cas pour votre temps passé sur ma demande et votre aide.

A+
Marvin57