Améliorer l'enregistreur de macros sur filtre

Aujourd'hui à 15:38

Bonjour à tous,

J'ai utilisé l'enregistreur de Macro pour m'aider à créer deux onglets supplémentaires, mais surtout de filter différemment les mêmes colonnes sur chaque onglet.

- Vano Inf qui filtre G à "0" et K à "VB"

Jusque là ça va, mais peut qu'en VBA il y a plus simple ?!

- Vano Sup qui filtre Ken "Z1" et G qui devrait me sélectionner tout ce qu'il y a en >=4

Sauf que je n'aurai jamais les mêmes valeurs selon les utilisateurs ; ça peut aller jusqu'à plus de 50 !

D'où ma question s'il vous plait !

Y a 't'il un bout de code qui existe pour remplacer le miens (celui enregistré avec l'enregistreur de macros) qui dirait que je veux tout ce qui est égal ou supérieur à 4 ?

Je vous remercie et vous souhaite une agréable journée

Bien à vous

Sub Macro2()

    Application.ScreenUpdating = False

    Sheets("Masque1").Select
    'ActiveSheet.Buttons.Add(800, 32.5, 164.5, 62.5).Select

    Sheets("Masque1").Copy Before:=Sheets(5)
    Sheets("Masque1 (2)").Select
    Sheets("Masque1 (2)").Name = "Vano Inf"
    ActiveSheet.Range("$A$1:$S$767").AutoFilter Field:=7, Criteria1:="0"
    ActiveSheet.Range("$A$1:$S$767").AutoFilter Field:=11, Criteria1:="VB"
    ActiveWindow.SmallScroll Down:=61
    'ActiveSheet.Shapes("Bouton 1").Delete
    ActiveWindow.ScrollRow = 1
    Range("A1").Select

    Sheets("Masque1").Copy Before:=Sheets(6)
    Sheets("Masque1 (2)").Select
    Sheets("Masque1 (2)").Name = "Vano Sup"
    ActiveSheet.Range("$A$1:$S$767").AutoFilter Field:=7, Criteria1:=Array("17" _
        , "22", "38", "39", "4", "5", "54", "6", "7"), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$S$767").AutoFilter Field:=11, Criteria1:="Z1"

    ActiveWindow.SmallScroll Down:=61
    ActiveWindow.ScrollRow = 1
    Range("A1").Select

    'ActiveSheet.Shapes("Bouton 1").Delete
    Application.Goto [A2], True

    Sheets("Masque1").Select

    MsgBox "       *** MERCI DE PRENDRE  LE TEMPS DE LIRE CES QQS LIGNES *** " & Chr(10) & Chr(10) & _
"- Les lignes vides en colonne [A] ont bien été supprimées." & Chr(10) & Chr(10) & _
"- Deux onglets supplémentaires [Vano] vont être générés :" & Chr(10) & Chr(10) & _
"1) Vano Inf. > A mettre en ZF sur le Vano (car pas utilisé dans le KDW pendant l'année écoulée)" & Chr(10) & _
"2) Vano Sup > A proposer au TAV car ratio conso supérieure à 4 sur l'année sans VB." & Chr(10) & Chr(10) & _
"- Le bouton de Macro a été supprimé et ne pourra donc plus resservir. " & Chr(10) & Chr(10) & _
"- Merci alors de préserver votre fichier original pour travailler, en enregistrant celui-ci [sous] avec un autre nom. " & Chr(10) & Chr(10) & _
"                                            Bonne synthèse…"

    Application.ScreenUpdating = True

End Sub
Aujourd'hui à 16:05

Bonjour à tous. Essayez ça :

```vba
Sub Creer_Onglets_Vano()

    Dim wb As Workbook
    Dim wsMasque As Worksheet
    Dim wsVanoInf As Worksheet
    Dim wsVanoSup As Worksheet

    On Error GoTo GestionErreur

    Set wb = ThisWorkbook
    Set wsMasque = wb.Worksheets("Masque1")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    '==========================================================
    ' SUPPRESSION DES ANCIENS ONGLETS S'ILS EXISTENT
    '==========================================================

    On Error Resume Next
    wb.Worksheets("Vano Inf").Delete
    wb.Worksheets("Vano Sup").Delete
    On Error GoTo GestionErreur

    '==========================================================
    ' CREATION DE L'ONGLET VANO INF
    '==========================================================

    wsMasque.Copy After:=wsMasque
    Set wsVanoInf = ActiveSheet

    wsVanoInf.Name = "Vano Inf"

    With wsVanoInf.Range("A1:S767")

        'Colonne G = 0
        .AutoFilter Field:=7, Criteria1:="0"

        'Colonne K = VB
        .AutoFilter Field:=11, Criteria1:="VB"

    End With

    '==========================================================
    ' CREATION DE L'ONGLET VANO SUP
    '==========================================================

    wsMasque.Copy After:=wsVanoInf
    Set wsVanoSup = ActiveSheet

    wsVanoSup.Name = "Vano Sup"

    With wsVanoSup.Range("A1:S767")

        'Colonne G = 4, 5, 6, 7, 17, 22, 38, 39 ou 54
        .AutoFilter Field:=7, _
            Criteria1:=Array("4", "5", "6", "7", "17", "22", "38", "39", "54"), _
            Operator:=xlFilterValues

        'Colonne K = Z1
        .AutoFilter Field:=11, Criteria1:="Z1"

    End With

    '==========================================================
    ' RETOUR SUR LE MASQUE
    '==========================================================

    wsMasque.Activate
    wsMasque.Range("A1").Select

    '==========================================================
    ' MESSAGE FINAL
    '==========================================================

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox _
        "La synthèse Vano est terminée." & vbCrLf & vbCrLf & _
        "Deux onglets ont été créés :" & vbCrLf & vbCrLf & _
        "• Vano Inf : Colonne G = 0 et Colonne K = VB" & vbCrLf & _
        "• Vano Sup : Colonne G = 4, 5, 6, 7, 17, 22, 38, 39 ou 54 et Colonne K = Z1" & vbCrLf & vbCrLf & _
        "L'onglet Masque1 d'origine a été conservé.", _
        vbInformation, _
        "Synthèse Vano"

    Exit Sub

'==============================================================
' GESTION DES ERREURS
'==============================================================

GestionErreur:

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox _
        "Une erreur est survenue lors de la création des onglets Vano." & vbCrLf & vbCrLf & _
        "N° d'erreur : " & Err.Number & vbCrLf & _
        "Description : " & Err.Description, _
        vbCritical, _
        "Erreur"

End Sub
```
Aujourd'hui à 16:13

Re : mais attention, vous utilisez la plage " A1:S767", une nouvelle ligne ajoutée après la ligne 767 serait ignorée. Le mieux serait de travailler à partir d'un tableau structuré

Aujourd'hui à 16:21

Re,

C'est super, merci beaucoup, c'est top

Aujourd'hui à 18:16

Re ;-)

Une question cependant à Claude :

Lorsque j'automatise par enregistrement, j'ai la même chose en terme de critère1 ?!

Ma question était bien de palier à cela si j'avais 56, 72,82, etc plus tard ! J'avais bien précisé, que les critères devaient être supérieurs à 4 sans, si possible bien sûr, sans autres critères

  'Colonne G = 4, 5, 6, 7, 17, 22, 38, 39 ou 54
        .AutoFilter Field:=7, _
            Criteria1:=Array("4", "5", "6", "7", "17", "22", "38", "39", "54"), _
            Operator:=xlFilterValues
Aujourd'hui à 18:17

@Claude

Tableau structuré ?!

Merci

A toute

Il y a 17 minutes

dasaquit : compliqué de répondre sans fichier. Un fichier me permettrait de mieux appréhender le problème. Un tableau structuré est une plage de données qu'Excel transforme en véritable objet « Tableau ».

Au lieu d'avoir simplement des données posées dans des cellules, on demande à Excel de créer un tableau avec Insertion → Tableau. En VBA (macro), très pratique pour modifier ou supprimer des données entre autres. De plus, lorsque l'on rajoute une ligne, elle est automatiquement intégrée dans le tableau. On le nomme et où qu'il soit placé dans la feuille, la macro le retrouve, grâce au nom qu'on lui aura donné ; Si tu veux une aide plus efficace, mets en pièce jointe ton fichier.

Coedialement.

Il y a 13 minutes

Re sub corrigé(si j'ai bien compris

```vba
Sub Creer_Onglets_Vano()

    Dim wb As Workbook
    Dim wsMasque As Worksheet
    Dim wsVanoInf As Worksheet
    Dim wsVanoSup As Worksheet

    On Error GoTo GestionErreur

    Set wb = ThisWorkbook
    Set wsMasque = wb.Worksheets("Masque1")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    '==========================================================
    ' SUPPRESSION DES ANCIENS ONGLETS S'ILS EXISTENT
    '==========================================================

    On Error Resume Next
    wb.Worksheets("Vano Inf").Delete
    wb.Worksheets("Vano Sup").Delete
    On Error GoTo GestionErreur

    '==========================================================
    ' CREATION DE L'ONGLET VANO INF
    '==========================================================

    wsMasque.Copy After:=wsMasque
    Set wsVanoInf = ActiveSheet

    wsVanoInf.Name = "Vano Inf"

    With wsVanoInf.Range("A1:S767")

        'Colonne G = 0
        .AutoFilter Field:=7, Criteria1:="0"

        'Colonne K = VB
        .AutoFilter Field:=11, Criteria1:="VB"

    End With

    '==========================================================
    ' CREATION DE L'ONGLET VANO SUP
    '==========================================================

    wsMasque.Copy After:=wsVanoInf
    Set wsVanoSup = ActiveSheet

    wsVanoSup.Name = "Vano Sup"

    With wsVanoSup.Range("A1:S767")

        'Colonne G >= 4
        .AutoFilter Field:=7, Criteria1:=">=4"

        'Colonne K = Z1
        .AutoFilter Field:=11, Criteria1:="Z1"

    End With

    '==========================================================
    ' RETOUR SUR MASQUE1
    '==========================================================

    wsMasque.Activate
    wsMasque.Range("A1").Select

    '==========================================================
    ' FIN
    '==========================================================

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox _
        "La synthèse Vano est terminée." & vbCrLf & vbCrLf & _
        "Deux onglets ont été créés :" & vbCrLf & vbCrLf & _
        "• Vano Inf : Colonne G = 0 et Colonne K = VB" & vbCrLf & _
        "• Vano Sup : Colonne G >= 4 et Colonne K = Z1" & vbCrLf & vbCrLf & _
        "L'onglet Masque1 d'origine a été conservé.", _
        vbInformation, _
        "Synthèse Vano"

    Exit Sub

'==============================================================
' GESTION DES ERREURS
'==============================================================

GestionErreur:

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox _
        "Une erreur est survenue lors de la création des onglets Vano." & vbCrLf & vbCrLf & _
        "N° d'erreur : " & Err.Number & vbCrLf & _
        "Description : " & Err.Description, _
        vbCritical, _
        "Erreur"

End Sub
```
Rechercher des sujets similaires à "ameliorer enregistreur macros filtre"