Filtre auto avec critère non existant vba

popcorn

XLDnaute Occasionnel
Bonjour à toutes et à tous,

Cela fait fort longtemps que je n'étais pas passé par ici. Je me lance sur un projet vba, mais ça fait un moment que j'ai pas mis la main à la pate..


J'ai besoin d'insérer des formules dans plusieurs feuilles en fonction d'un critère.
J'utilise un filtre auto mais il arrive que le critère cherché ne soit pas present dans la colonne.
J'ai passé la journée à farfouiller mon code au point que j'y vois plus très clair.
J'aurais besoin de votre aide.

Je procède comme suit :

- Je filtre chaque feuille avec le critère en différente langues.
- J'active les feuille une à une et j'y colle mon code pour insérer ma formule

J'ai essayé plusieurs choses, cela fonctionne si le critère existe. En revanche, lorsque il n'est pas present cela m'efface le titre de mon tableau.

Comment faire pour qu'il ne me colle pas cette "formule" si le critère n'existe pas? Et d'autre part, il me semble que ce n'est pas conseiller d'utiliser trop de .activate

Je vous mets le code dessous avec un fichier.

Merci de votre aide.

Code:
Sub test()

    Dim DerLigDE As Long
    Dim DerLigFR As Long
    Dim DerLigIT As Long
    Dim DerLigES As Long
    Dim k As Integer, i As Integer
    Dim Cell As Range

    DerLigDE = Sheets("DE").Range("A65536").End(xlUp).Row
    DerLigFR = Sheets("FR").Range("A65536").End(xlUp).Row
    DerLigIT = Sheets("IT").Range("A65536").End(xlUp).Row
    DerLigES = Sheets("ES").Range("A65536").End(xlUp).Row

       Sheets("DE").Range("$A$1:$AB" & DerLigDE).AutoFilter Field:=3, Criteria1:="Einstellung"
       Sheets("FR").Range("$A$1:$AB" & DerLigFR).AutoFilter Field:=3, Criteria1:="Ajustement"
       Sheets("IT").Range("$A$1:$AB" & DerLigIT).AutoFilter Field:=3, Criteria1:="Modifica"
       Sheets("ES").Range("$A$1:$AB" & DerLigES).AutoFilter Field:=3, Criteria1:="Ajuste"

k = Sheets.Count
For i = 1 To k
    Sheets(i).Activate
     For Each Cell In Range("X2:X" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
                Cell.FormulaR1C1 = "=RC[-1]-RC[-15]"
            Next Cell
     For Each Cell In Range("AA2:AA" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
                 Cell.FormulaR1C1 = "=RC[-3]-RC[-1]"
            Next Cell
Next i
End Sub
 

Pièces jointes

  • Test_Macro_CA_Europe_ED.xlsx
    15.5 KB · Affichages: 10

apnart

XLDnaute Occasionnel
Bonjour Popocorn,

J'ai justement aidé une collègue la semaine dernière sur ce point :)

En fait il faut tester si après ton filtre, la 1ère ligne retournée est la ligne 2 (celle juste après les entêtes de colonnes).

Ci joint un p'tit exemple avec une liste, et un msgbox qui donne le N° de la ligne quand on lance la macro "TrouveLigne", j'espère que ça va t'aider :)

Le code en question :
Sub TrouveLigne()

Dim NumLigne As Long

NumLigne = Range("A2:A" & Range("A1048576").End(xlUp).Row).SpecialCells(xlVisible).Cells(1, 1).Row

MsgBox NumLigne

End Sub


A+
Bruno.
 

Pièces jointes

  • Trouver_numéro_première_ligne_filtrée.xlsm
    13.2 KB · Affichages: 8

popcorn

XLDnaute Occasionnel
Bonjour apnart,

Merci pour ta réponse. Non, ça ne marche pas cela me renvoie le numéro de la dernière ligne filtrée.

Je me suis rendu compte que j'ai oublié de mettre ma macro dans le fichier que j'ai televersé sur le post..

Par contre, je pense faire différemment finalement, je n'y avais pas pensé hier.

J'ai plusieurs macro, dont une qui affecte le libellé des titres, je vais tout simplement la lancé après celle des filtres et l'insertion de toutes mes formules.

Cela m'évitera des lignes de code supplémentaire, c'est pas nickel mais cela marchera.

Merci


PS: Si quelqu'un passe par la, je reste intéressé mais je vais faire autrement pour le moment, alors perdez pas votre temps.
 

Statistiques des forums

Discussions
314 633
Messages
2 111 403
Membres
111 123
dernier inscrit
lauTTTTTTTTT