Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Arrêt du code dès la première cellule vide rencontrée

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

AreYouBush

XLDnaute Junior
Bonsoir le forum,

J'ai ce code :
Code:
Private Sub Workbook_Open()
Dim Cel As Range, s As String
With Sheets("Bdd")
s = "Attention!! Faire demande ou renouvellement de passeport pour :"
For Each Cel In Range("D2:" & Range("D2").End(xlDown).Address)
    If Cel.Value - 6000 <= Date Then
        s = s & vbCr & Cel.Offset(0, -1) & " " & Cel.Offset(0, -3)
    End If
Next Cel
If Left(s, 1) <> ":" Then MsgBox s
End With
End Sub
qui me renvois la liste des personnes devant refaire leur passeport à 60 jours (la j'ai mis 6000 pour le test) de l'expiration de celui-ci.
Le hic est que dans ma colonne il y a des cellules non renseignées, et que le code me renvoi que les personnels avant la première cellule vide rencontré et fait l'impasse sur les autres.

Que faudrait il rajouter ou corriger dans le code pour qu'il ne s’arrête pas a la première cellule vide?

Ci-joint un fichier épuré, ne pas faire attention aux erreurs vu que j'ai effacé la plupart du contenu.

Merci d'avance. Bisou
 

Pièces jointes

Re : Arrêt du code dès la première cellule vide rencontrée

Bonsoir,
à tester :
Code:
Private Sub Workbook_Open()
Dim Cel As Range, s As String
With Sheets("Bdd")
s = "Attention!! Faire demande ou renouvellement de passeport pour :"
For Each Cel In Range("D2:" & Range("D" & Rows.Count).End(xlUp).Address)
    If Cel.Value - 6000 <= Date And Cel.Value <> "" Then
        s = s & vbCr & Cel.Offset(0, -1) & " " & Cel.Offset(0, -3)
    End If
Next Cel
If Left(s, 1) <> ":" Then MsgBox s
End With
End Sub
A+
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
4
Affichages
1 K
Réponses
1
Affichages
1 K
Réponses
3
Affichages
1 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…