1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
| Sub compiler()
Dim lig As Long, lig2 As Long, derlig As Long
Application.ScreenUpdating = False
[H:M].ClearContents
[A:D].Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess
lig2 = 1
For lig = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(lig, 1) <> Cells(lig - 1, 1) Then
If lig2 > 1 Then Cells(lig2, 10) = Left(Cells(lig2, 10), Len(Cells(lig2, 10)) - 3)
lig2 = lig2 + 1
Cells(lig, 1).Resize(1, 2).Copy Cells(lig2, 8)
End If
Cells(lig2, 10) = Cells(lig2, 10) & Cells(lig, 3) & " - "
Next lig
Application.ScreenUpdating = True
End Sub |
Partager