Un besoin un peu suxxxxxxx !!!! merci par avance

[mathieums]

Hello all,

Je souhaiterais créer une macro qui reprendrai le besoin ci-dessous :

Rechercher dans une colonne D une valeur définit 'TOTO par exemple'

Le numéro de la ligne sera très important car il me permettra de renseigner des valeurs sur la même ligne pour la colonne C , E, F et G.

On copie les valeurs d'une formule d'une feuille2 ou l'on retrouve aussi une ligne TOTO en colonne B vers la feuille 1 colonne E F et G de la ligne ou l'on a trouvé la ligne TOTO.

Par la suite on copie le valeur de la colonne C de la ligne TOTO dans la cellule D.

Je pense que malgrés les explications ce n'est pas trés parlant, j'ai donc un petit excel d'explications avec un exemple.

Merci par avance pour vos réponses.

A+

Mathieu

 

[Robert]

Re : Un besoin un peu suxxxxxxx !!!! merci par avance

Bonsoir Mathieums, bonsoir le forum,

Peut-être comme ça :

Sub Macro1()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)

Set pl = Sheets("Feuil1").Columns(4).SpecialCells(xlCellTypeConstants) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    Select Case cel.Value 'agit en fonction de la valeur de la cellule cel
        Case "TOTO", "TITI" 'cas "TOTO" et "TITI"
            'définit la recherche r (recherche dans la colonne D de l'onglet "Feuil2" la valeur exacte de la cellule cel)
            Set r = Sheets("Feuil2").Columns(4).Find(cel.Value, , xlValues, xlWhole)
                If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
                    cel.Value = cel.Offset(0, -1).Value 'récupère la valeur de la colonne C
                    r.Offset(0, 1).Resize(1, 8).Copy 'copie la ligne (colonne E à L) de l'occurrence trouvé
                    cel.Offset(0, 2).PasteSpecial (xlPasteValues) 'colle la plage dans la colonne F de l'onglet "Feuil1"
                End If 'fin de la condition
    End Select 'fin de l'action en fonction de la valeur de la cellule cel
Next cel 'prochaine cellule de la boucle
End Sub

 

[mathieums]

Re : Un besoin un peu suxxxxxxx !!!! merci par avance

Merci bcp Robert pour cette réponse rapide comme l’éclair.

La macro fonctionne exactement comme je l'avais demandé

Mais j'avais hélas mal spécifié ma demande , désolé !!!!

La valeur de la feuill2 n'est pas toto ou titi mais garçon ou oiseau ( valeur positionné dans la col C de la ligne ou il y a titi ou toto).

Par contre la recherche peut s’arrêter à partir de la ligne 70

A+ et merci encore pour cette aide précieuse.

Mathieu

 

[Robert]

Re : Un besoin un peu suxxxxxxx !!!! merci par avance

Bonsoir Mathieums, bonsoir le forum,

Il suffit de modifier la ligne du Find comme ça :

Set r = Sheets("Feuil2").Columns(4).Find(cel.Offset(0, -1).Value, , xlValues, xlWhole)

Des fois je me demande à quoi ça sert que je commente les codes...

 

[mathieums]

Re : Un besoin un peu suxxxxxxx !!!! merci par avance

Super !!!

Ça marche nickel !!!

En y réfléchissant au lieu de copier les valeurs, ne serait il pas possible de copier un appel à la cellule exemple '=Feuil2!E7' etc ...

Merci encore, je ne sais plus quoi dire

Mathieu

 

[Robert]

Re : Un besoin un peu suxxxxxxx !!!! merci par avance

Bonsoir Mathieu, bonsoir le forum,

Moi je pense qu'il faut que tu arrêtes de réfléchir... Essaie comme ça :

Sub Macro1()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim r As Range 'déclare la variable r (Recherche)

Set pl = Sheets("Feuil1").Columns(4).SpecialCells(xlCellTypeConstants) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    Select Case cel.Value 'agit en fonction de la valeur de la cellule cel
        Case "TOTO", "TITI" 'cas "TOTO" et "TITI"
            'définit la recherche r (recherche dans la colonne D de l'onglet "Feuil2" la valeur exacte de la cellule cel)
            Set r = Sheets("Feuil2").Columns(4).Find(cel.Offset(0, -1).Value, , xlValues, xlWhole)
                If Not r Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
                    cel.Value = cel.Offset(0, -1).Value 'récupère la valeur de la colonne C
                    For i = 2 To 9
                        cel.Offset(0, i).Formula = "=Feuil2!" & r.Offset(0, i - 1).Address
                    Next i
                End If 'fin de la condition
    End Select 'fin de l'action en fonction de la valeur de la cellule cel
Next cel 'prochaine cellule de la boucle
End Sub

 

[mathieums]

Re : Un besoin un peu suxxxxxxx !!!! merci par avance

Merci bcp Robert pour tout ton aide qui a été très précieuse.

Bonne continuation.

Mathieu

 

[mathieums]

Re : Un besoin un peu suxxxxxxx !!!! merci par avance

Je vais encore jouer le relou, mille excuse !!!

Si je ne voudrais que copier la formule de la cellule et non l'adresse ?

Encore une fois Merci

A+
Mathieu