Fonction find VBA

Bonjour;

J'ai un code vba sert a trouver un valeur saisie dans B1 dans la totalité du classeur et me renvoi des donnes lie au ligne et column de se dernier ce code est:

Set cel= ws.cells.find(what:=nom, lookin:=xlvalues, lookat:=xlwhole)

If not cel is nothing then

Range ("E" & ligne) = cel.offset(0, 1-(cel.column)).

Le code fonction pour la premier occurence de B1 résultat dans E1.

Comment modifier le code pour que la deuxième occurence soit dans B2 et résultat dans E2 et la troisième et quatrième de même façon merci.

Bonjour Troy, bonjour le forum,

Peut-être comme ça :

Public Sub Macro1()
Dim CEL As Range
Dim PA As String
Dim ligne As Integer

'ligne doit être initialisée !...
Set CEL = ws.Cells.Find(Range("B1").Value, LookIn:=xlValues, lookat:=xlWhole)
If Not CEL Is Nothing Then
    PA = CEL.Address
    Do
        Range("E" & ligne) = CEL.Offset(0, 1 - (CEL.Column))
        ligne = ligne + 1
        Set CEL = FindNext(CEL)
    Loop While Not C Is Nothing And CEL.Address <> PA
End If
End Sub

Merci pour la réponse rapide

"Sub ou fonction non définie " pour la fonction findnext ????

Merci bcp.

Re,

Oui désolé je n'ai pas spécifié où chercher :

Public Sub Macro1()
Dim CEL As Range
Dim PA As String
Dim ligne As Integer

'ligne doit être initialisée !...
Set CEL = ws.Cells.Find(Range("B1").Value, LookIn:=xlValues, lookat:=xlWhole)
If Not CEL Is Nothing Then
    PA = CEL.Address
    Do
        Range("E" & ligne) = CEL.Offset(0, 1 - (CEL.Column))
        ligne = ligne + 1
        Set CEL = ws.Cells.FindNext(CEL)
    Loop While Not C Is Nothing And CEL.Address <> PA
End If
End Sub

"Pour qu'il soit utile" c'est le code a modifier:

Option Explicit

Sub Recherche(Nom As String, Ligne As Long)

Dim Cel As Range

Dim Depart As String

Dim Ws As Worksheet

Range("C" & Ligne & ":D" & Ligne & ":E" & Ligne & ":F" & Ligne).ClearContents

For Each Ws In Sheets(Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "K", "L"))

Set Cel = Ws.Cells.Find(what:=Nom, LookIn:=xlValues, lookat:=xlWhole)

If Not Cel Is Nothing Then

Range("E" & Ligne) = Cel.Offset(0, 1 - (Cel.Column))

Range("F" & Ligne) = Cel.Offset(-(Range("E" & Ligne)), 0)

Range("D" & Ligne) = Cel.Offset(-(1 + Range("E" & Ligne)), 1 - (Cel.Column))

Range("C" & Ligne) = Cel.Offset(-(1 + (Range("E" & Ligne))), -(Cel.Column) + 2)

Range("B" & Ligne).Interior.Color = Cel.Interior.Color

Exit Sub

End If

Next Ws

'MsgBox "Numéro introuvable!!!"

End Sub

Comment integrer le boucle et merci.

Re,

Peut-être comme ça (non testé) :

Sub Recherche(Nom As String, ligne As Long)
Dim Ws As Worksheet
Dim CEL As Range
Dim PA As String
Dim TEST As Boolean

For Each Ws In Sheets(Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "K", "L"))
    Ws.Cells(ligne, "C").Resize(1, 4).ClearContents
    Set CEL = Ws.Cells.Find(what:=Nom, LookIn:=xlValues, lookat:=xlWhole)
    If Not CEL Is Nothing Then
        PA = CEL.Address
        TEST = True
        Do
            Range("E" & ligne) = CEL.Offset(0, 1 - (CEL.Column))
            Range("F" & ligne) = CEL.Offset(-(Range("E" & ligne)), 0)
            Range("D" & ligne) = CEL.Offset(-(1 + Range("E" & ligne)), 1 - (CEL.Column))
            Range("C" & ligne) = CEL.Offset(-(1 + (Range("E" & ligne))), -(CEL.Column) + 2)
            Range("B" & ligne).Interior.Color = CEL.Interior.Color
            ligne = ligne + 1
            Set CEL = Ws.Cells.FindNext(CEL)
        Loop While Not C Is Nothing And CEL.Address <> PA
    Else
        Exit For
    End If
Next Ws
If TEST = False Then MsgBox "Numéro introuvable!!!"
End Sub

Le boucle ne tourne pas!!!!

Toujours une seul ligne , la première occurrence.

Autre chose la recherche se fait que dans la feuille A (next ws comme si ne présente pas)

Merci.

Re,

Sans fichier je ne peux pas tester...

Bonjour,

Merci pour votre coopération

Ci joint le modèle test.

Re,

Essaie comme ça :

Sub Recherche(Nom As String, ligne As Long)
Dim ORC As Worksheet
Dim Ws As Worksheet
Dim CEL As Range
Dim PA As String
Dim TEST As Boolean

Set ORC = Worksheets("Recherche")
For Each Ws In Sheets(Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "K", "L"))
    ORC.Cells(ligne, "B").Resize(1, 5).ClearContents
    Set CEL = Ws.Cells.Find(what:=Nom, LookIn:=xlValues, lookat:=xlWhole)
    If Not CEL Is Nothing Then
        PA = CEL.Address
        TEST = True
        Do
            ORC.Range("E" & ligne) = CEL.Offset(0, 1 - (CEL.Column))
            ORC.Range("F" & ligne) = CEL.Offset(-(Range("E" & ligne)), 0)
            ORC.Range("D" & ligne) = CEL.Offset(-(1 + Range("E" & ligne)), 1 - (CEL.Column))
            ORC.Range("C" & ligne) = CEL.Offset(-(1 + (Range("E" & ligne))), -(CEL.Column) + 2)
            ORC.Range("B" & ligne).Interior.Color = CEL.Interior.Color
            ORC.Range("B" & ligne).Value = Nom
            ligne = ligne + 1
            Set CEL = Ws.Cells.FindNext(CEL)
        Loop While Not CEL Is Nothing And CEL.Address <> PA
    End If
Next Ws
If TEST = False Then MsgBox "Numéro introuvable!!!"
End Sub

Merci c vraiment génial

C se que je voulait

Un grand merci.