Recherche dans une ligne et modifier mise en forme

Bonjour tout le monde,

Voilà, je viens solliciter vos compétences car je n'arrive pas à trouver par moi-même.

J'ai un tableau d'export que je fais régulièrement et pour arrêter de faire la mise en forme manuellement, j'ai décidé de faire une macro pour automatiser tout ça.

Mon problème est le suivant :

• Recherche dans tout le tableau la présence d'un terme "Présent dans l'ADN"

• En boucle jusqu'à ce que tout le tableau soit analysé

• Si je trouve le terme "Présent dans l'ADN", je sélectionne toute la ligne je mets tout cela en rouge et en gras

Le point 1 et 3, c'est bon mais je n'arrive pas à réaliser la boucle qui doit faire que l'analyse continue.... Je lance la recherche et je trouve la première ligne et après plus rien.

Par avance merci pour l'aide que vous pourrez m'apporter

Bonjour et bienvenue,

Merci de joindre un petit fichier à ta demande.

Cdlt.

Bonjour,

Une piste :

Sub Test()

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String
    Dim Chaine As String

    Chaine = "Présent dans l'ADN"

    Set Fe = ActiveSheet

    'défini la plage à partir de A1
    Set Plage = DefPlage(Fe)

    Set Cel = Plage.Find(Chaine, , xlValues, xlWhole)

    If Not Cel Is Nothing Then

        Adr = Cel.Address

        Do

            'colore en rouge la ligne de la plage
            With Plage: .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, Plage.Columns.Count)).Font.ColorIndex = 3: End With

            Set Cel = Plage.FindNext(Cel)

        Loop While Cel.Address <> Adr

    End If

End Sub

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

Raaaah je me doutais que vous me demanderiez des fichiers

Je vous ai préparé ça ce matin

Si ça n'est pas suffisant, dites moi

Theze, je cherche à intégrer ton code, mais pour l'instant....

Si je pars sur une macro, c'est surtout parce que je peux avoir à gérer un fichier d'export de prêt de 1000 lignes donc....

A la fin de ton code, tu insères le mot "Recherche" à la place de tes lignes de recherche comme ci-dessous :

'...
'...
' Recherche des lignes "Présent dans l'ADN".
Recherche '<--- appelle la procédure "Recherche" !

' Sauvegarde le fichier dans le répertoire de destination
    ActiveWorkbook.SaveAs ActiveWorkbook.Path & "\Export.xlsx", FileFormat:= _
                          xlOpenXMLWorkbook, CreateBackup:=False
' Ferme le classeur ouvert
'    ActiveWorkbook.Close

et tu remplaces le code que je t'ai donné précédemment par celui-ci (recherche partielle) que tu colles sous ton code, on voit bien qu'il a été fait avec l'enregistreur, tu devrais éviter tous ces Select qui sont inutiles ! (je reposte aussi la fonction DefPlage) :

Sub Recherche()

    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Adr As String
    Dim Chaine As String

    Chaine = "Présent dans l'ADN"

    Set Fe = ActiveSheet

    'défini la plage à partir de A1
    Set Plage = DefPlage(Fe)

    Set Cel = Plage.Find(Chaine, , xlValues, xlPart)

    If Not Cel Is Nothing Then

        Adr = Cel.Address

        Do

            'colore en rouge la ligne de la plage
            With Plage

                With .Range(.Cells(Cel.Row, 1), .Cells(Cel.Row, Plage.Columns.Count)).Font
                    .ColorIndex = 3
                    .Bold = True
                End With

            End With

            Set Cel = Plage.FindNext(Cel)

        Loop While Cel.Address <> Adr

    End If

End Sub

Function DefPlage(Fe As Worksheet, Optional L As Long = 1, Optional C As Long = 1) As Range

    On Error GoTo Fin

    With Fe

        Set DefPlage = .Range(.Cells(L, C), _
                       .Cells(.Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))

    End With

    Exit Function

Fin:

    Set DefPlage = Nothing

End Function

Je ne maîtrise pas trop le VBA.... donc je me débrouille comme je peux tu sais

Et par manque de temps, je ne cherche pas trop...

Je teste ça demain matin si j'ai le temps Theze et je te dis ce qu'il en est !!

Merci déjà pour tes indications et ton code

Bon et bien petit retour sur tout ça !

Tout fonctionne parfaitement bien !!

Merci Theze pour ton aide

Bonjour,

Parfait, content de t'avoir aidé