Copier coller

[badoum66]

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

 

[TOFatJOB]

Re : Copier coller

bonjour,

voici une solution

 

[badoum66]

Re : Copier coller

Merci exactement ce qu'il me fallait.

Bon WE,

 

[Robert]

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

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

 

[badoum66]

Re : Copier coller

Terrible Robert, c'est ça qu'il me fallait la solution de Tofatjob tout compte fait ne me convenais pas.
Ta macro est excellente.

Merci beaucoup et Bon WE

 

[suistrop]

Re : Copier coller

Allez j y vais de ma macro en mode super LIGHT !!!

Sub copier()
For i = 2 To 22
    If Cells(i + 1, 2) = 0 Then
        Cells(i + 1, 2) = Cells(i, 2)
    End If
Next i
End Sub

Cordialement !!

 

[Robert]

Re : Copier coller

Bonsoir le fil, bonsoir le forum,

Mort de rire Suistrop... et mort de honte aussi...

 

[suistrop]

Re : Copier coller

Bonsoir le fil, bonsoir le forum,

Mort de rire Suistrop... et mort de honte aussi...

hello
t as pas a avoir honte t as macro j aurai jamais pu l écrire