Copier coller

badoum66

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

  • test.xls
    14.5 KB · Affichages: 69
  • test.xls
    14.5 KB · Affichages: 67
  • test.xls
    14.5 KB · Affichages: 68

Robert

XLDnaute Barbatruc
Repose en paix
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
 

suistrop

XLDnaute Impliqué
Re : Copier coller

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

Code:
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 !!
 

Pièces jointes

  • test_macro.xls
    23 KB · Affichages: 56
  • test_macro.xls
    23 KB · Affichages: 55
  • test_macro.xls
    23 KB · Affichages: 60

Discussions similaires

Réponses
6
Affichages
483

Statistiques des forums

Discussions
312 854
Messages
2 092 828
Membres
105 539
dernier inscrit
Morgane0202