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
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
mais encore....??ça marche pas