Macro recup email + traitement

Bonjour,

Avec la macro ci dessous je recupere le corps d'un email je le colle dans la feuille excel, et je range l'email dans un dossier traité, ça fonctionne comme je le veux.

Dans la seconde macro je souhaite récupérer certaines infos et les ranger dans une autre feuille, et là j'ai encore des soucis

La partie Diagnosis, Cause, correction, verification, test result en bas de la feuille 1 peuvent contenir plusieurs lignes et j'aurais aimé pouvoir récupérer les plus ieurs lignes (si il y en a) et les mettre à la suite dans ma feuille résultat (2016)

et le format de la date jj/mm/aa HH:hh j'aurais aimé lui supprimer les heures qui m'embette quelque peu.

Merci de votre aide.

Bonjour,

une proposition

nickel chrome merci !!!!!!!

en plus tu as simplifié mes 300 lignes en 4 lignes !!!!

Wonderfull

Bonjour tout le monde,

Dans le cas de certains emails la valeur retournée dans "re" de la recherche est Nothing : tout simplement car il n'y est pas. comment je peux lui dire à "case" que si "re is nothing end case

i = 1    'pointeur de colonne en feuil2
    For Each st In Array("date ", "system id", "site name", "RFS #", "system name", "- diagnosis", "- correction", "- verification", "- test result", "RFS status")
        Set re = F1.Cells.Find(What:=st, LookIn:=xlFormulas, _
                                             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                             MatchCase:=False, SearchFormat:=False)    ' re = cellule contenant le texte st
        Select Case st
        Case "- diagnosis"
             If re Is Nothing Then sort de là
            fr = re.Row    'fr = première ligne
            msg = re.Value    ' msg = texte
            k = fr + 1    ' k=pointeur de lignes dans multiligne
            c = re.Column    'c= colonne
            While Left(F1.Cells(k, c), 1) <> "-"    'tant qu'on n'a pas une ligne commençant par "-"
                msg = msg & F1.Cells(k, c)    'on complete le msg avec le contenu trouvé dans la nouvelle ligne
                k = k + 1    ' on passe à la ligne suiavnte
            Wend
            F2.Cells(1, i) = msg    ' on copie le msg en feuil2

Merci d'avance,

Ps : le fichier de "H2SO4"en haut du Fil est toujours valable même si il y a eu des modifs si besoin pour comprendre

Ok milles excuses j'ai trouvé,

il me fallait juste rajouter

 If Not re Is Nothing Then

avant de rentrer dans le case