Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel macro recherche

macro recherche

5 réponses
Avatar
naidinp
bonjour a tous,

voila j'ai trouve un code sur le site qui pourait m'aider=20
a rechercher une valeur sur ma feuille mais mois je ne=20
veut pas copier la ligne une fois qu'on a trouv=E9 la=20
valeur - je veut q'on s'arrete simplement sur la ligne=20
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 =3D InputBox(Prompt:=3D _
"Cha=EEne recherch=E9e.", _
Title:=3D"Rechercher et Remplacer")
If MonString =3D "" Then Exit Sub

With ActiveSheet
Set FoundCell =3D .Cells.Find(What:=3DMonString, _
LookIn:=3DxlValues, LookAt:=3DxlPart)
If Not FoundCell Is Nothing Then
Adr =3D FoundCell.Address
Do
Do
Pos =3D Pos + 1
Pos =3D InStr(Pos, FoundCell, MonString, vbTextCompare)
If Pos <> 0 Then Compteur =3D Compteur + 1
Loop Until Pos =3D 0
FoundCell.EntireRow.Select
reponse =3D MsgBox("Est ce cette ligne", vbYesNo, "Question")
If reponse =3D 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 =3D False
Suivant:
FoundCell.Select
Set FoundCell =3D .Cells.FindNext(After:=3DFoundCell)
If FoundCell Is Nothing Then Exit Do
If FoundCell.Address =3D Range(Adr).Address Then Exit Do
Loop While Not FoundCell Is Nothing
End If
End With
Set FoundCell =3D Nothing
End Sub
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Hervé
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" a écrit dans le message news:
0bb701c36e23$cbe85ea0$
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
Avatar
naidinp
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" a écrit dans le
message news:

0bb701c36e23$cbe85ea0$
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


.



Avatar
naidinp
..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" a écrit dans le
message news:

0bb701c36e23$cbe85ea0$
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


.





Avatar
Michel Gaboly
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" a écrit dans le
message news:

0bb701c36e23$cbe85ea0$
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


Avatar
Michel Gaboly
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" a écrit dans le
message news:

0bb701c36e23$cbe85ea0$
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