1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
| Sub test()
Dim old As Range, Dl As Long, plage As Range, meslignes As String, I As Long
Set plage = ActiveSheet.UsedRange ' adapter a ton contexte
Dl = Cells(Rows.Count, 1).End(xlUp).Row
Set old = plage.Cells(1, 1)
For I = 2 To Dl
If Cells(I, 1).Text = old.Text Then
If old.Offset(, 4) = "" And plage.Cells(I, 1).Offset(, 4).Text <> "" Then old.Offset(, 4) = plage.Cells(I, 1).Offset(, 4).Text: x = True
If old.Offset(, 5) = "" And plage.Cells(I, 1).Offset(, 5).Text <> "" Then old.Offset(, 5) = Cells(I, 1).Offset(, 5).Text: x = True
If old.Offset(, 6) = "" And plage.Cells(I, 1).Offset(, 6).Text <> "" Then old.Offset(, 6) = plage.Cells(I, 1).Offset(, 6).Text: x = True
If x = True Then meslignes = meslignes & " " & plage.Rows(I).Address
Else
Set old = plage.Cells(I, 1)
x = False
End If
Next
'netoyage
meslignes = Replace(Trim(meslignes), " ", ",")
plage.Parent.Range(meslignes).EntireRow.Delete
End Sub |
Partager