• Initiateur de la discussion Initiateur de la discussion badoum66
  • 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 !

B

badoum66

Guest
Bonjour,

Voiçi mon problème, dans le fichier test.xls j'explique ce qu'il me faudrait. compliquer à expliquer à l'écrit. C'est tout simplement une forme de copier coller avec instruction.


Merci pour vos réponses et Bon WE
 

Pièces jointes

Re : Copier coller

Bonjour Badoum, Tof at job, bonjour le forum,

J'arrive après la bagarre mais tant pis, je t'envoie ma proposition par macro quand même...

Code:
Sub Macro1()
Dim cel As Range 'déclarfe la variable cel (CELlule)
Dim r As Range 'déclare la variable r(Recherche)
Dim pa As String 'déclare la variable pa (Première Adresse)
Dim pl As Range 'déclare la variable pl (PLage)
Dim dl As Integer 'déclare la variable dl (Dernière Ligne)
Dim of As Variant 'déclare la variable of (OFfset)
dl = Range("A65536").End(xlUp).Row 'définit la dernière ligne dl de la colonne A
Set pl = Range("A3:A" & dl) 'définit la plage pl
For Each cel In pl 'boucle sur toutes les cellules éditées de la plage pl
    If cel.Interior.ColorIndex = 3 Then GoTo suite 'si la cellule a le fond rouge, passe à la cellule suivante via l'étiquette "suite"
    
    If cel.Offset(0, 1).Value <> "" Then 'condition : si la cellule à droite de cel n'est pas vide
        cel.Interior.ColorIndex = 3 'colorie le fond de cel en rouge
        of = cel.Offset(0, 1).Value 'définit la, variable of
        pa = cel.Address 'définit la variable pa
        Set r = pl.Find(cel.Value) 'définit la variable r
        If Not r Is Nothing Then 'condition 2: si il existe au moins une occurrence de r
            Do 'éxécute
                r.Interior.ColorIndex = 3 'colorie le fond de r en rouge
                r.Offset(0, 1).Value = of 'donne à la cellule à droite de r la valeur de la variable of
                Set r = pl.FindNext(r) 'redéfinit la variable r
            Loop While Not r Is Nothing And r.Address <> pa 'boucle tant que l'adresse de r est différente de pa
        End If 'fin de la condition 2
    End If 'fin de la condition 1
suite: 'étiquette
Next cel 'prochaine cellule éditée de la plage pl
pl.Interior.ColorIndex = 0 'supprime la couleur rouge de la plage pl
End Sub
 
- 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
3
Affichages
326
Réponses
1
Affichages
467
Réponses
10
Affichages
1 K
Retour