Remplacer Valeur par une autre

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 !

manulemalin13000

XLDnaute Occasionnel
Bonjour,

J'ai besoin de votre aide pour un petit detail dans une macro...
En resumé la macro ci dessous cherche une valeur ( en l'occurence ici DQB1*03) et copie et colle diverses données.
Mon probleme c'est que la macro puisse faire ca avec DQB1*04 ou un tout autre nom
L'ideal serait soit une boite de dialogue ou l'on rentre le mot a chercher soit une cellule dans laquelle on fixe là ou la macro va chercher ce qu'elle doit faire

J'espere que je suis clair...

merci pour votre aide

Manu



Sub trisheet3()
Dim Cel As Range
Dim Del As Range
Dim Lig As Byte
Lig = 1

Sheets("Sheet3").Select
For Each Cel In Range("L1:L" & Range("A65536").End(xlUp).Row)
If Left(Cel, 12) = "DQB1*03" Then
Cel.Copy Destination:=Sheets("Sheet5").Range("A" & Lig)
Cel.Offset(0, -11).Copy Destination:=Sheets("Sheet5").Range("B" & Lig)
Lig = Lig + 1
End If
Next Cel
Sheets("Sheet5").Select
Application.Run "trisheet4"
End Sub
 
Re : Remplacer Valeur par une autre

Bonjour manu, bonjour le forum,

Peut-être comme ça :
Code:
Sub trisheet3()
Dim br As String 'déclare la variable br (Boite de Recherche)
Dim r As Range 'déclare la variable r (Recherche)
 
With Sheets("Sheet3") 'prend en compte l'onglet "Sheet3"
    .Select 'sélectionne l'onglet
    'définit la boite de recherche br
    br = Application.InputBox("Tapez la valeur que vous recherchez.", "Recherche !", Type:=2)
    If br = "" Then Exit Sub 'si br né st pas renseiggnée, sort de la procédure
    'définit la recherche r (recherche br dans la colonne L de l'onglet "Sheet3")
    Set r = .Range("L1:L" & .Range("A65536").End(xlUp).Row).Find(br, , xlValues, xlWhole)
    If Not r Is Nothing Then 'condition : si il existe au moins une occurrence
        r.Copy Destination:=Sheets("Sheet5").Range("A" & r.Row) 'copy et colle
        r.Offset(0, -11).Copy Destination:=Sheets("Sheet5").Range("B" & r.Row) 'copie et colle
    End If 'fin de la condition
End With 'fin de la prise en compte de l'onglet "Sheet3"
Sheets("Sheet5").Select 'sélectionne l'onglet "Sheet5"
Application.Run "trisheet4"
End Sub
 
Re : Remplacer Valeur par une autre

Bonjour à tous,

Cher Robert merci pour ton aide mais la macro que tu m as faite ne reproduit pas le meme resultat que celle que j avais fourni. De plus ne pouvant poster un echantillon de mon fichier car il est tres lourd et en plus il comporte des données sensibles je ne vais pas pouvoir te donner la possibilité de modifier le code.
Merci d'avoir essayé

Manu
 
- 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

Discussions similaires

Réponses
5
Affichages
591
Retour