XL 2013 copier coller avec condition

pes_com

XLDnaute Nouveau
Bonjour,
je reste bloqué pour une manip qui est certainement simple pour les experts que l'on trouve sur ce site!


copier coller avec condition juste les ligue dans la colonne A comme celle photo merci


Lien supprimé
 

Pièces jointes

  • aide22.xlsx
    54.4 KB · Affichages: 33

vgendron

XLDnaute Barbatruc
Hello
avec ce code dans un module standard vba (Alt + F11 pour ouvrir l'éditeur)

Code:
Sub recopie()
'pour chaque nom de la colonne A
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    'on récupère le nom
    Nom = Cells(i, 1)
    'on le cherche dans la colonne B
    Set c = Range("B:B").Find(Nom, lookat:=xlWhole)
    If Not c Is Nothing Then 'si trouvé
        'on regarde le nombre de ligne à copier (attention! elles doivent etre VIDES SANS ESPACE)
     
        x = c.End(xlDown).Row - 1
        'on initialise la zone à recopier
        Set zone = c.Resize(x - c.Row + 1)
        'on copie les 4 colonnes à droite
        zone.Offset(0, 1).Resize(, 4).Copy Destination:=zone.Offset(0, 6)
    End If
Next i
End Sub

attention. ton fichier doit etre légèrement nettoyé.
Dans ta colonne B, des cellules apparemment vides contiennent en fait des espaces
il faut les effacer
 

Pièces jointes

  • aide22.xlsm
    98.7 KB · Affichages: 39
Dernière édition:

vgendron

XLDnaute Barbatruc
re.. avais tu vu ma proposition?

que j'ai modifié ici pour prendre en compte la présence multiple d'une ligue en colonne B
Code:
Sub recopie()
'on commence par effacer les colonnes H--K
Columns("H:K").ClearContents
'pour chaque nom de la colonne A
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    'on récupère le nom
    Nom = Cells(i, 1)
    'on le cherche dans la colonne B
    With Range("B:B") ' & Rows.Count.End(xlUp).Row)
        Set c = .Find(Nom, lookat:=xlWhole)
        If Not c Is Nothing Then 'si trouvé
            firstAdress = c.Address
            Do 'au cas où la ligue apparaitrait plusieurs fois dans la colonne
                'on regarde le nombre de lignes à copier (attention! elles doivent etre VIDES SANS ESPACE)
                x = c.End(xlDown).Row - 1
                'on initialise la zone à recopier
                Set zone = c.Resize(x - c.Row + 1)
                'on copie les 4 colonnes à droite
                zone.Offset(0, 1).Resize(, 4).Copy Destination:=zone.Offset(0, 6)
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAdress
        End If
    End With
Next i
End Sub
 

Membres actuellement en ligne

Statistiques des forums

Discussions
312 229
Messages
2 086 426
Membres
103 206
dernier inscrit
diambote