XL 2010 Recherche un mot et copie sur une autre feuille VBA

[girolle74]

Bonjour,


Pouvez-vous m'aider à créer une macro sous EXCEL?


1- je saisie un nombre (ex: 743),
2- je saisie un symbole (ex: # )
Excel va chercher dans la feuille 'BASE' le nombre (743) copie la cellule contenant le nombre demandé (743) et la couleur correspondante,
Excel va coller cette ligne dans une feuille 'modèle' en A2 et en B2 colle le symbole (#).

Excel revient à l'étape 1et 2

si j'ai fini ma saisie je clic sur 'annuler' et la feuille 'Modèle' apparait avec tous les codes et symboles que j'ai saisie auparavant.


(feuille 'Base' = environ 500 nombres et couleurs correspondantes aux code DMC)

MERCI

 

[Wayki]

Bonjour,

Worksheets(1).cells.find(743).copy worksheets("modèle").range("A2")

Worksheets("modèle").range("B2").value = "#"

À adapter bien évidemment

 

[girolle74]

Bonjour,


À adapter bien évidemment

Bonjour
Merci
J'ai omis qu'il faut copier la couleur de la cellule avec le nombre recherché (743 fond orange).
500 lignes avec un nombre et une couleur de fond.
Si non c'est ok
Cordialement

 

[Wayki]

Comment est obtenue la couleur de fond ?
Car le code est censé copier la cellule y compris le fond, sauf il me semble si la couleur est obtenue via MFC.
N'hésitez pas à poster un fichier afin que l'on puisse vous aider au mieux...

 

[girolle74]

Comment est obtenue la couleur de fond ?
Car le code est censé copier la cellule y compris le fond, sauf il me semble si la couleur est obtenue via MFC.
N'hésitez pas à poster un fichier afin que l'on puisse vous aider au mieux...

Bonjour,
merci pour votre aide
les couleurs de fond sont obtenues avec la formule: (Interior.Color = RGB( 250,255,210)
ci-joint fichier

 

[Wayki]

Bien, dans ce cas là, Remplacer le code que je vous ai fourni par celui ci :
Worksheets(1).cells.find(743).copy
With worksheets("modèle").range("A2")
.paste
.interior.color = RGB(250,255,210)
.offset(1,0).value = "#"
End with

A +

 

[girolle74]

Bien, dans ce cas là, Remplacer le code que je vous ai fourni par celui ci :
Worksheets(1).cells.find(743).copy
With worksheets("modèle").range("A2")
.paste
.interior.color = RGB(250,255,210)
.offset(1,0).value = "#"
End with

A +

Bonjour et merci pour vôtre aide très sympa.

voilà ce que je suis arrivé à faire mais je n'arrive pas à arrêter la macro sans plantage

cordialement
Geoffroy

Sub rechercheDMC()
 
    Dim i As Integer
    Dim DMC As Integer
    Dim sym As String
   
   
Worksheets("BASE").Activate
   For i = 2 To 5 ' boucle que je n'arrive pas à positionner de façon à l'arreter sans plantage

  DMC = InputBox("recherche du DMC")
  If DMC = 0 Then Exit Sub
    sym = InputBox("Symbole")

    Worksheets("BASE").Cells.Find(DMC).Copy
With Worksheets("modèle").Range("A" & i)
.PasteSpecial Paste:=xlPasteFormats
.Value = DMC
End With
Worksheets("modèle").Range("B" & i).Value = sym
 
 
   Next

End Sub

 

[Wayki]

Essayer ce code sans certitudes

Sub rechercheDMC()
 
    Dim i As Integer
    Dim DMC As Integer
    Dim sym As String
  
  
Worksheets("BASE").Activate
   For i = 2 To 5 ' boucle que je n'arrive pas à positionner de façon à l'arreter sans plantage

1:  DMC = InputBox("recherche du DMC")
  If DMC = 0 Then Exit Sub
    sym = InputBox("Symbole")
On error Goto err
    Worksheets("BASE").Cells.Find(DMC).Copy
With Worksheets("modèle").Range("A" & i)
.PasteSpecial Paste:=xlPasteFormats
.Value = DMC
End With
Worksheets("modèle").Range("B" & i).Value = sym
 
 
   Next
err:
MsgBox "N'existe pas"
Goto 1
End Sub

 

[girolle74]

Essayer ce code sans certitudes

Sub rechercheDMC()
 
    Dim i As Integer
    Dim DMC As Integer
    Dim sym As String
 
 
Worksheets("BASE").Activate
   For i = 2 To 5 ' boucle que je n'arrive pas à positionner de façon à l'arreter sans plantage

1:  DMC = InputBox("recherche du DMC")
  If DMC = 0 Then Exit Sub
    sym = InputBox("Symbole")
On error Goto err
    Worksheets("BASE").Cells.Find(DMC).Copy
With Worksheets("modèle").Range("A" & i)
.PasteSpecial Paste:=xlPasteFormats
.Value = DMC
End With
Worksheets("modèle").Range("B" & i).Value = sym
 
 
   Next
err:
MsgBox "N'existe pas"
Goto 1
End  Sub

Bonsoir,
merci mais ça plante
je vais m'en servir tel quel.

merci de ton aide
A+

 

[Wayki]

Oups, j'ai oublié un exit sub.
ça fonctionne chez moi, la boucle se réalise 4 fois (de 2 à 5) où il faut rentrer 4 fois le code recherché.
si il faut rentrer 4 fois le meme code, alors copier ce code :

Sub rechercheDMC()
 
    Dim i As Integer
    Dim DMC As Integer
    Dim sym As String
 
 
Worksheets("BASE").Activate
   ' boucle que je n'arrive pas à positionner de façon à l'arreter sans plantage

1:  DMC = InputBox("recherche du DMC")
  If DMC = 0 Then Exit Sub
    sym = InputBox("Symbole")
 For i = 2 To 5
On error Goto err
    Worksheets("BASE").Cells.Find(DMC).Copy
With Worksheets("modèle").Range("A" & i)
.PasteSpecial Paste:=xlPasteFormats
.Value = DMC
End With
Worksheets("modèle").Range("B" & i).Value = sym
 
 
   Next
exit sub

err:
MsgBox "N'existe pas"
Goto 1
End Sub

Ci-joint
A +