Discussion :

[uti2012]

Bonjour, je sollicite votre aide afin d'améliorer ma macro qui lance un filtre dans la feuille "DOS", copier la sélection et la coller sur la feuille fournisseur concerné.

Ma demande est : est-il possible de dire à la macro que si le filtre n’amène pas de résultat de passer directement à sub end ?

Ma demande est : Ci-dessous la macro en question.

Code vba :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub IMPORT_FEUILLE_ARB() 
Application.ScreenUpdating = False
 
Sheets("DOS").Select
ActiveSheet.Range("A:Z").AutoFilter Field:=26, Criteria1:="ARB" 
Range("A3:X3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
 
    Sheets("ARB").Select 
 
    Dim DerniereLigne As Long
'Téléchargez le dernier numéro de ligne utilisé
DerniereLigne = Cells(Rows.Count, 2).End(xlUp).Row
'Sélectionnez la ligne suivante ci-dessous
Cells(DerniereLigne, 1).Offset(1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
 
nblig = Range("B3").End(xlDown).Row
Range("A3:A" & nblig).FormulaR1C1 = "A faire"
 
Sheets("DOS").Select
Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
   ActiveSheet.Rows("3:80000").SpecialCells(xlCellTypeVisible).Delete
 
 
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub

[joe.levrai]

Bonjour,

il y a plusieurs méthodes.
Pour ma part (ce n'est pas la solution la plus élégante), j'utilise la fonction NBVAL.

Il faut que la colonne où on effectue le test ne contienne aucune cellule vide

si NBVAL = 1 alors pas de résultat au filtre (il n'y a que la cellule contenant l'en-tête de colonne)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Application.WorksheetFunction.Subtotal(3, Sheets("DOS")..Range("A:A")) = 1 Then Exit Sub

[uti2012]

merci beaucoup joe.levrai .

[MarcelG]

Bonsoir à vous, Bonsoir au Forum,

Salut, Joe. Content de te retrouver.

Un autre processus pourrait consister en l'utilisation de la méthode Find qui retourne un objet Range.
Si ce Range n'est pas rien alors le iltre s'applique.

Un 3ème enfin consisterait à tester la place de chaque item dans la colonne de donnée en gérant un retour d'erreur éventuel.

J'ai un programme en cours.
Je reviens au plus vite avec une ou deux propositions de code.

[MarcelG]

Bonsoir,

Sur le 1er processus (que je préfère)

Ici
Une feuille du classeur comprend la table des données (tableau structuré) "LaTable" contenant une colonne "Parent".
Son CodeName est "LesDonnées"
Une autre feuille contient un tableau structuré "T_Crit" contenant une colonne "Id"
Le code va
- rechercher chaque item "Id" dans "LaTable" à la colonne "Parent"
- si l'item est trouvé (fonction "Equiv" en Excel, "Match" en VBA) alors "LaTable" est filtrée et son corps de données est supprimé

A noter que la méthode

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.DatabodyRange.Delete

ne s'affecte qu'aux lignes visibles.
C'est la raison pour laquelle la suppression du filtre éventuel est une précaution utile avant toute explloitation d'un tableau structuré dans ce sens.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
Option Explicit
 
Public Sub suppr_crit()
 
Dim c As Range
Dim eq As Long
 
With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
End With
 
For Each c In Range("T_Crit[Id]")
        eq = Evaluate("=IFERROR(MATCH(""" & c.Value & """,LaTable[Parent],0),0)")
        If eq > 0 Then
                Call épure_latable(lechamp:="Parent", lecrit:=c.Value)
        End If
Next c
 
With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
End With
 
End Sub
 
Private Sub épure_latable(lechamp As Variant, lecrit As Variant)
 
Dim numchamp As Integer
 
With LesDonnées
        If .FilterMode = True Then .ListObjects("LaTable").AutoFilter.ShowAllData
        With .ListObjects("LaTable")
                numchamp = .ListColumns(lechamp).Index
                'Filtre
                .Range.AutoFilter _
                        Field:=numchamp, Criteria1:=lecrit
                .DataBodyRange.Delete
        End With
        .ListObjects("LaTable").AutoFilter.ShowAllData
End With
 
 
End Sub