XL 2019 Filtres automatiques

kiff77 · 12 Février 2021

Bonjour à tous,

J'ai fait quelques recherches mais je n'ai pas trouvé mon bonheur.

J'ai deux onglets :
- le premier avec ma BDD
- le second avec un bouton

Lorsque je clique sur le bouton, je souhaite sélectionner l'ensemble des données non vides de la colonne 1 et remplir les cellules de la colonne 3 avec la valeur "ok". J'arrive par VBA à effectuer ma sélection mais je n'arrive pas à sélectionner la première cellule de la sélection et remplir les cellules.

Je joins un fichier exemple.

Merci d'avance pour vos réponses.
Bien cordialement,
Franck

mapomme · 12 Février 2021

Bonjour @kiff77,

Essayez cette macro:

VB:

Sub Macro9()
Dim derlig, t, i&
   With Sheets("Feuil1")
       If .FilterMode Then .ShowAllData
       derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
       t = .Range("a1:c" & derlig)
       For i = 2 To UBound(t)
         If t(i, 1) <> "" Then t(i, 3) = "ok"
      Next i
      .Range("a1:c" & derlig) = t
   End With
End Sub

kiff77 · 12 Février 2021

Bonjour mapomme,

Merci pour votre réponse.

Votre code fonctionne parfaitement. En revanche, et je ne l'avais pas précisé, dans mon fichier de travail, la colonne A est une formule. Après essai, le code supprime l'ensemble des formules.

Merci encore
Cdt
Franck

mapomme · 12 Février 2021

Re,

kiff77 à dit:
et je ne l'avais pas précisé, dans mon fichier de travail, la colonne A est une formule. Après essai, le code supprime l'ensemble des formules.

Essayez le code modifié (une seule ligne a été modifiée):

VB:

Sub Macro9()
Dim derlig, t, i&
   With Sheets("Feuil1")
       If .FilterMode Then .ShowAllData
       derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
       t = .Range("a1:c" & derlig)
       For i = 2 To UBound(t)
         If t(i, 1) <> "" Then t(i, 3) = "ok"
      Next i
      .Range("c1:c" & derlig) = Application.Index(t, 0, 3)
   End With
End Sub

kiff77 · 12 Février 2021

Mapomme,

Nickel!!

Merci pour le temps passé

Excellent WE
Franck

XL 2019 Filtres automatiques

kiff77

XLDnaute Junior

Pièces jointes

mapomme

XLDnaute Barbatruc

kiff77

XLDnaute Junior

mapomme

XLDnaute Barbatruc

kiff77

XLDnaute Junior

Discussions similaires