Création d'une VBA si cellule H6 écrite passer à H7

Bonjour je rencontre un problème pour faire une VBA

Sur une feuille, en fonction de la date du jour si un produit est en fin d'utilisation sa référence et sa nature apparaissent.

Sa référence en H6 et sa nature en I6

Le problème c'est que si j'ai plusieurs produits dont la date de péremption est le même jour un seul apparait.

Je souhaiterai donc si la cellule H6 est remplie passer à la cellule H7....

PS:

En fichier joint ma page d'accueil comment ce présente la fin d'utilisation avec référence et nature du produit. Puis la macro disant que si la date de fin d'utilisation est aujourd’hui faire apparaitre le produit sur la page d'accueil

Bonjour,

peux-tu mettre le fichier (anonymisé si nécessaire) ou une copie de la macro plutôt qu'une photo dont on ne sait rien faire ?

Voici la macro

Ma page d'accueil ou doit apparaitre les produits périmés

bonjour,

une proposition d'adaptation de ta macro

Private Sub Worksheet_Activate()
    datedujour = Date
    k = 6
    t = Array("AQUAMATE 8000", "ci annions", "CI CATIONS", "DBS", _
              "DCO", "Etalon Ammonium", "Etalon B1000", "Etalon ETA", "Etalon Lithium", _
              "Etalon Nitrate", "Etalon Nitrite 1000 ppm", "Etalon Phosphate", "Etalon Sulfate", _
              "Etalons chlorure 1000ppm", "Genesys", "Hydrazine", "pH 10", "pH 7", "pH 9", "QC Ammonium", _
              "QC Chlorure", "QC ETA", "QC Lithium", "QC Nitrate", "QC Nitrite", "QC Phosphate", "QC Sulfate", "SECOMAN")
    For Each wsn In t
        If Worksheets(wsn).Range("H9").Value = datedujour Then
            Worksheets("Accueil").Range("H" & k).Value = Worksheets(wsn).Range("A9").Value
            Worksheets("Accueil").Range("I" & k).Value = wsn
            k = k + 1
        End If
    Next wsn
End Sub

ça fonctionne merci beaucoup

ça fonctionne merci beaucoup

Désolé mais en fait cela ne fonctionne pas pour ci anions, cations, aquamate, genesys, secoman car pour eux les cellules sont B9 et E9

bonjour,

un adaptation

Private Sub Worksheet_Activate()
    datedujour = Date
    k = 6
    t = Array("DBS", _
              "DCO", "Etalon Ammonium", "Etalon B1000", "Etalon ETA", "Etalon Lithium", _
              "Etalon Nitrate", "Etalon Nitrite 1000 ppm", "Etalon Phosphate", "Etalon Sulfate", _
              "Etalons chlorure 1000ppm", "Hydrazine", "pH 10", "pH 7", "pH 9", "QC Ammonium", _
              "QC Chlorure", "QC ETA", "QC Lithium", "QC Nitrate", "QC Nitrite", "QC Phosphate", "QC Sulfate")
    For Each wsn In t
        If Worksheets(wsn).Range("H9").Value = datedujour Then
            Worksheets("Accueil").Range("H" & k).Value = Worksheets(wsn).Range("A9").Value
            Worksheets("Accueil").Range("I" & k).Value = wsn
            k = k + 1
        End If
    Next wsn
    t = Array("ci anions", "ci cations", "aquamate 8000", "genesys", "secoman")
    For Each wsn In t
        If Worksheets(wsn).Range("E9").Value = datedujour Then
            Worksheets("Accueil").Range("H" & k).Value = Worksheets(wsn).Range("B9").Value
            Worksheets("Accueil").Range("I" & k).Value = wsn
            k = k + 1
        End If
    Next wsn
End Sub

Merci ça fonctionne, autre petit problème par exemple quand je rentre une date de péremption à aujourdhui pour un etalon nitrite, un qc chlorure cela supprime genesys, aquamate...

quand je rentre aussi un qc ou etalon il n'apparait qu'après que j'ai rentré un autre produit

bonjour,

difficile de répondre sans voir le fichier et sans savoir ce que tu fais exactement pour avoir ce bug.

donc merci de mettre un fichier exemple, avec les instructions pour reproduire le problème et les infos sur le résultat que tu obtiens et sur le résultat attendu.

le fichier est trop gros

bonjour

c'est pour cela que je parlais d'un fichier exemple (qui contient le minimum de données pour reproduire le problème que tu rencontres)

si tu veux mettre ton fichier dans sa totalité mets-le sur cjoint.com et mets le lien ici

C'est bon on m'a aidé j'arrive bien à avoir la référence et la nature du produit s'il y en à plusieurs ils s'affichent à la ligne .

Par contre quand je vais dans une autre page et que je retourne à la page d'accueil le produit s'affiche plusieurs fois, par exemple je reviens deux fois sur la page d'accueil il s'affiche deux fois.

voir fichier joint

Bonsoir,

ce n'est pas la macro que je t'ai fournie.

pour rappel voici le code et j'ai mis des commentaires

Private Sub Worksheet_Activate()
    datedujour = Date
    k = 6 'n° de la ligne où écrire le produit périmé
    ' t est un tableau qui contient la liste des feuilles dont la date à tester est en H9 et la donnée à copier est en A9
    t = Array("DBS", _
              "DCO", "Etalon Ammonium", "Etalon B1000", "Etalon ETA", "Etalon Lithium", _
              "Etalon Nitrate", "Etalon Nitrite 1000 ppm", "Etalon Phosphate", "Etalon Sulfate", _
              "Etalons chlorure 1000ppm", "Hydrazine", "pH 10", "pH 7", "pH 9", "QC Ammonium", _
              "QC Chlorure", "QC ETA", "QC Lithium", "QC Nitrate", "QC Nitrite", "QC Phosphate", "QC Sulfate")

    For Each wsn In t 'pour chaque feuille de t
        If Worksheets(wsn).Range("H9").Value = datedujour Then 'on a trouvé un produit périmé. Moi je mettrais <= au lieu de =
            Worksheets("Accueil").Range("H" & k).Value = Worksheets(wsn).Range("A9").Value 'on écrit la valeur en colonne "H" sur la ligne k
            Worksheets("Accueil").Range("I" & k).Value = wsn 'on écrit le nom en colonne "I" sur la ligne k
            k = k + 1 'numéro de ligne suivant sur laquelle écrire le prochain produit périmé s'il y en a un
        End If
    Next wsn
    ' t est un tableau qui contient la liste des feuilles dont la date à tester est en E9 et la donnée à copier est en B9
    t = Array("ci anions", "ci cations", "aquamate 8000", "genesys", "secoman")
    For Each wsn In t 'pour chaque feuille de t
        If Worksheets(wsn).Range("E9").Value = datedujour Then
            Worksheets("Accueil").Range("H" & k).Value = Worksheets(wsn).Range("B9").Value
            Worksheets("Accueil").Range("I" & k).Value = wsn
            k = k + 1
        End If
    Next wsn
End Sub

oui mais cette macro ne fonctionne pas correctement il y a des produits qui ce suprime....

bonsoir,

sur base de ce que j'ai compris la macro fonctionne. J'ai surement mal compris, mais je n'ai pas la possibilité de vérifier.

la macro que j'ai fournie n'efface aucune donnée. dans la version jointe, j'ai ajouté un effacement de la liste des produits périmés avant la regénération de la liste. j'ai également considéré comme périmés les produits dont la date de péremption est <= à la date du jour au lieu de ceux dont la date de péremption est égale à la date du jour.

C'est bon cela fonctionne, en modifiant un peu mon fichier merci