• Initiateur de la discussion Initiateur de la discussion naidinp
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

N

naidinp

Guest
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
 
Bonjour Naidinp,

Voilà la macro adaptée à ta demande qui va sélectionner la ligne selon le résultat de la recherche mais sans la copier...j'ai laissé la selection de la ligne pour que le résultat soit plus parlant à l'exécution de cette macro

' ==================================
Option Explicit

Sub Recher_articles()

Dim MonString As String
Dim FoundCell As Range
Dim LeString As Variant
Dim Variable As String
Dim Reponse As String

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

With ActiveSheet
Set FoundCell = .Cells.Find(What:=MonString)
If FoundCell Is Nothing Then MsgBox "aucune donnée trouvée pour : " _
& MonString, vbInformation, "=> Résultat": Exit Sub

FoundCell.EntireRow.Select
Reponse = MsgBox("Est-ce cette ligne ?", vbYesNo, "Question")
If Reponse = vbYes Then
Exit Sub
Else
[A1].Select
GoTo Retour
End If
End With
End Sub
' ==================================

A+Veriland.gif
 
Dis moi Robert...c'est une plaisanterie ?

si s'en est une, elle est de mauvais goût...

car là ce n'est pas une aide que tu donnes mais carrément une promotion pour visiter ton site...qui de plus et rempli de Pub...!!!

mettre un lien pour que l'on fasse nous même la recherche de ton fichier c'est un peu fort...en plus je ne supporte pas la publicité intempestive...

non...honnêtement je n'ai pas encore dit grand chose au sujet de certains de tes agissements mais là çà frise l'arrogance...si comme tes dires tu es capables de jouer au plus fin, sache que nous sommes aussi équipés...

à mon avis tu n'as p'têt pas encore compris la philosophie qui est la nôtre...

Donc je me permettrai juste un p'tit conseil tout à fait amicale et respectueux...

Attention à ne pas trop tirer sur l'élastique...car il risque de te revenir...

A+Veriland.gif
 
Bonsoir à tous,

Véri tu as raison, moi je trouve aussi déplacé ce que fait utilsfr, qui plus est son commentaire laissé sur sa dernière appli sur le foot en shareware, en regardant son code on voit bien que c'est pas vraiment de lui, puisque il appartient à l'enregistreur de macro.

A+++


PS désolé Mr Robert de dire cela mais au moins en parlant de toi on te fait de la pub.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
7
Affichages
334
Réponses
9
Affichages
404
Réponses
2
Affichages
332
Retour