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

girolle74

XLDnaute Nouveau
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

XLDnaute Impliqué
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...
 
Dernière édition:

girolle74

XLDnaute Nouveau
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
 

Pièces jointes

  • recherche-couleur.xlsm
    32.5 KB · Affichages: 5

Wayki

XLDnaute Impliqué
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

XLDnaute Nouveau
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

VB:
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
 

Pièces jointes

  • rechercheDMC.xlsm
    18.7 KB · Affichages: 3

Wayki

XLDnaute Impliqué
Essayer ce code sans certitudes
VB:
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

XLDnaute Nouveau
Essayer ce code sans certitudes
VB:
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

XLDnaute Impliqué
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 :
VB:
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 +
 

Pièces jointes

  • rechercheDMC.xlsm
    22.1 KB · Affichages: 9

Discussions similaires

Statistiques des forums

Discussions
313 309
Messages
2 097 030
Membres
106 811
dernier inscrit
MERAPYAAR