macro recherche

Salut Paul,
Voilà :
Sub Chercher_articles()
Dim MonString As String
Dim FoundCell As Range
MonString = InputBox("Chaîne recherchée.", _
"Rechercher.")
If MonString = "" Then Exit Sub

Set FoundCell = ActiveSheet.Cells _
.Find(MonString, , xlValues, xlPart)
If Not FoundCell Is Nothing Then
FoundCell.EntireRow.Select
End If
Set FoundCell = Nothing
End Sub

Hervé.

"naidinp" <paul.naidin@odsh.asso.fr> a écrit dans le message news:
0bb701c36e23$cbe85ea0$a101280a@phx.gbl...
bonjour a tous,

voila j'ai trouve un code sur le site qui pourait m'aider
a rechercher une valeur sur ma feuille mais mois je ne
veut pas copier la ligne une fois qu'on a trouvé la
valeur - je veut q'on s'arrete simplement sur la ligne
correspondante - comment faire (newbie)

merci d'avance


Sub Recher_articles()

Dim MonString As String, FoundCell As Range, Adr As String
Dim LeString As Variant, Compteur As Long, Pos As Integer

MonString = InputBox(Prompt:= _
"Chaîne recherchée.", _
Title:="Rechercher et Remplacer")
If MonString = "" Then Exit Sub

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString, _
LookIn:=xlValues, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Adr = FoundCell.Address
Do
Do
Pos = Pos + 1
Pos = InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur = Compteur + 1
Loop Until Pos = 0
FoundCell.EntireRow.Select
reponse = MsgBox("Est ce cette ligne", vbYesNo, "Question")
If reponse = 7 Then
GoTo Suivant
End If
Selection.Copy
Sheets("Sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.EntireRow.PasteSpecial
Sheets("Sheet1").Select
Application.CutCopyMode = False
Suivant:
FoundCell.Select
Set FoundCell = .Cells.FindNext(After:=FoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address = Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
Set FoundCell = Nothing
End Sub

merci pour ta reponse. J'ai teste le code mais il ne
marche pas (..Find(MonString, , xlValues, xlPart) why ?

thx

-----Message d'origine-----
Salut Paul,
Voilà :
Sub Chercher_articles()
Dim MonString As String
Dim FoundCell As Range
MonString = InputBox("Chaîne recherchée.", _
"Rechercher.")
If MonString = "" Then Exit Sub

Set FoundCell = ActiveSheet.Cells _
..Find(MonString, , xlValues, xlPart)
If Not FoundCell Is Nothing Then
FoundCell.EntireRow.Select
End If
Set FoundCell = Nothing
End Sub

Hervé.

"naidinp" <paul.naidin@odsh.asso.fr> a écrit dans le
message news:

0bb701c36e23$cbe85ea0$a101280a@phx.gbl...
bonjour a tous,

voila j'ai trouve un code sur le site qui pourait m'aider
a rechercher une valeur sur ma feuille mais mois je ne
veut pas copier la ligne une fois qu'on a trouvé la
valeur - je veut q'on s'arrete simplement sur la ligne
correspondante - comment faire (newbie)

merci d'avance


Sub Recher_articles()

Dim MonString As String, FoundCell As Range, Adr As String
Dim LeString As Variant, Compteur As Long, Pos As Integer

MonString = InputBox(Prompt:= _
"Chaîne recherchée.", _
Title:="Rechercher et Remplacer")
If MonString = "" Then Exit Sub

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString, _
LookIn:=xlValues, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Adr = FoundCell.Address
Do
Do
Pos = Pos + 1
Pos = InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur = Compteur + 1
Loop Until Pos = 0
FoundCell.EntireRow.Select
reponse = MsgBox("Est ce cette ligne",
vbYesNo, "Question")

If reponse = 7 Then
GoTo Suivant
End If
Selection.Copy
Sheets("Sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.EntireRow.PasteSpecial
Sheets("Sheet1").Select
Application.CutCopyMode = False
Suivant:
FoundCell.Select
Set FoundCell = .Cells.FindNext(After:=FoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address = Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
Set FoundCell = Nothing
End Sub


.

..nickel - c marche

merci a tous

-----Message d'origine-----
Bonjour,

Apparemment, il y a une faute de frappe dans le code : 2
points à la suite au lieu d'un seul

"..Find" au lieu de ".Find"

merci pour ta reponse. J'ai teste le code mais il ne
marche pas (..Find(MonString, , xlValues, xlPart) why ?

thx

-----Message d'origine-----
Salut Paul,
Voilà :
Sub Chercher_articles()
Dim MonString As String
Dim FoundCell As Range
MonString = InputBox("Chaîne recherchée.", _
"Rechercher.")
If MonString = "" Then Exit Sub

Set FoundCell = ActiveSheet.Cells _
..Find(MonString, , xlValues, xlPart)
If Not FoundCell Is Nothing Then
FoundCell.EntireRow.Select
End If
Set FoundCell = Nothing
End Sub

Hervé.

"naidinp" <paul.naidin@odsh.asso.fr> a écrit dans le
message news:

0bb701c36e23$cbe85ea0$a101280a@phx.gbl...
bonjour a tous,

voila j'ai trouve un code sur le site qui pourait
m'aider

a rechercher une valeur sur ma feuille mais mois je ne
veut pas copier la ligne une fois qu'on a trouvé la
valeur - je veut q'on s'arrete simplement sur la ligne
correspondante - comment faire (newbie)

merci d'avance


Sub Recher_articles()

Dim MonString As String, FoundCell As Range, Adr As
String

Dim LeString As Variant, Compteur As Long, Pos As
Integer

MonString = InputBox(Prompt:= _
"Chaîne recherchée.", _
Title:="Rechercher et Remplacer")
If MonString = "" Then Exit Sub

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString, _
LookIn:=xlValues, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Adr = FoundCell.Address
Do
Do
Pos = Pos + 1
Pos = InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur = Compteur + 1
Loop Until Pos = 0
FoundCell.EntireRow.Select
reponse = MsgBox("Est ce cette ligne",
vbYesNo, "Question")

If reponse = 7 Then
GoTo Suivant
End If
Selection.Copy
Sheets("Sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.EntireRow.PasteSpecial
Sheets("Sheet1").Select
Application.CutCopyMode = False
Suivant:
FoundCell.Select
Set FoundCell = .Cells.FindNext(After:=FoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address = Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
Set FoundCell = Nothing
End Sub


.

--
Cordialement,

Michel Gaboly
http://www.gaboly.com


.

Bonjour,

Apparemment, il y a une faute de frappe dans le code : 2 points à la suite au lieu d'un seul

"..Find" au lieu de ".Find"

merci pour ta reponse. J'ai teste le code mais il ne
marche pas (..Find(MonString, , xlValues, xlPart) why ?

thx

-----Message d'origine-----
Salut Paul,
Voilà :
Sub Chercher_articles()
Dim MonString As String
Dim FoundCell As Range
MonString = InputBox("Chaîne recherchée.", _
"Rechercher.")
If MonString = "" Then Exit Sub

Set FoundCell = ActiveSheet.Cells _
..Find(MonString, , xlValues, xlPart)
If Not FoundCell Is Nothing Then
FoundCell.EntireRow.Select
End If
Set FoundCell = Nothing
End Sub

Hervé.

"naidinp" <paul.naidin@odsh.asso.fr> a écrit dans le
message news:

0bb701c36e23$cbe85ea0$a101280a@phx.gbl...
bonjour a tous,

voila j'ai trouve un code sur le site qui pourait m'aider
a rechercher une valeur sur ma feuille mais mois je ne
veut pas copier la ligne une fois qu'on a trouvé la
valeur - je veut q'on s'arrete simplement sur la ligne
correspondante - comment faire (newbie)

merci d'avance


Sub Recher_articles()

Dim MonString As String, FoundCell As Range, Adr As String
Dim LeString As Variant, Compteur As Long, Pos As Integer

MonString = InputBox(Prompt:= _
"Chaîne recherchée.", _
Title:="Rechercher et Remplacer")
If MonString = "" Then Exit Sub

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString, _
LookIn:=xlValues, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Adr = FoundCell.Address
Do
Do
Pos = Pos + 1
Pos = InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur = Compteur + 1
Loop Until Pos = 0
FoundCell.EntireRow.Select
reponse = MsgBox("Est ce cette ligne",
vbYesNo, "Question")

If reponse = 7 Then
GoTo Suivant
End If
Selection.Copy
Sheets("Sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.EntireRow.PasteSpecial
Sheets("Sheet1").Select
Application.CutCopyMode = False
Suivant:
FoundCell.Select
Set FoundCell = .Cells.FindNext(After:=FoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address = Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
Set FoundCell = Nothing
End Sub


.

--
Cordialement,

Michel Gaboly
http://www.gaboly.com

De rien ;-))

..nickel - c marche

merci a tous

-----Message d'origine-----
Bonjour,

Apparemment, il y a une faute de frappe dans le code : 2
points à la suite au lieu d'un seul

"..Find" au lieu de ".Find"

merci pour ta reponse. J'ai teste le code mais il ne
marche pas (..Find(MonString, , xlValues, xlPart) why ?

thx

-----Message d'origine-----
Salut Paul,
Voilà :
Sub Chercher_articles()
Dim MonString As String
Dim FoundCell As Range
MonString = InputBox("Chaîne recherchée.", _
"Rechercher.")
If MonString = "" Then Exit Sub

Set FoundCell = ActiveSheet.Cells _
..Find(MonString, , xlValues, xlPart)
If Not FoundCell Is Nothing Then
FoundCell.EntireRow.Select
End If
Set FoundCell = Nothing
End Sub

Hervé.

"naidinp" <paul.naidin@odsh.asso.fr> a écrit dans le
message news:

0bb701c36e23$cbe85ea0$a101280a@phx.gbl...
bonjour a tous,

voila j'ai trouve un code sur le site qui pourait
m'aider

a rechercher une valeur sur ma feuille mais mois je ne
veut pas copier la ligne une fois qu'on a trouvé la
valeur - je veut q'on s'arrete simplement sur la ligne
correspondante - comment faire (newbie)

merci d'avance


Sub Recher_articles()

Dim MonString As String, FoundCell As Range, Adr As
String

Dim LeString As Variant, Compteur As Long, Pos As
Integer

MonString = InputBox(Prompt:= _
"Chaîne recherchée.", _
Title:="Rechercher et Remplacer")
If MonString = "" Then Exit Sub

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString, _
LookIn:=xlValues, LookAt:=xlPart)
If Not FoundCell Is Nothing Then
Adr = FoundCell.Address
Do
Do
Pos = Pos + 1
Pos = InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur = Compteur + 1
Loop Until Pos = 0
FoundCell.EntireRow.Select
reponse = MsgBox("Est ce cette ligne",
vbYesNo, "Question")

If reponse = 7 Then
GoTo Suivant
End If
Selection.Copy
Sheets("Sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.EntireRow.PasteSpecial
Sheets("Sheet1").Select
Application.CutCopyMode = False
Suivant:
FoundCell.Select
Set FoundCell = .Cells.FindNext(After:=FoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address = Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
Set FoundCell = Nothing
End Sub


.

--
Cordialement,

Michel Gaboly
http://www.gaboly.com


.

--
Cordialement,

Michel Gaboly
http://www.gaboly.com