1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
| Option Explicit
Sub Assemblage()
Dim I As Integer
Dim J As Long
Dim Lg As Long
Dim Msg As String
Dim ColDep As Integer
Dim LigDep As Long
Dim dc As Long
ColDep = 1
LigDep = 1
If Range("A1") <> "" Then
Lg = Range("A" & Rows.Count).End(xlUp).Row
End If
With Sheets("Feuil1")
For J = LigDep To .Cells.Find("*", , , , xlByRows, xlPrevious).Row
Msg = ""
dc = .Cells(J, .Columns.Count).End(xlToLeft).Column
For I = ColDep To dc
If .Cells(J, I) <> "" Then
Msg = Msg & .Cells(J, I)
End If
Next I
If Len(Msg) > 0 Then
Range("A" & J).Offset(0, dc) = Left(Msg, Len(Msg))
Lg = Lg + 1
End If
Next J
End With
Range("A" & J).Offset(0, dc).Sort key1:=Sheets("Feuil1").Range("A" & J).Offset(0, dc), Order1:=xlAscending, Header:=xlGuess
Columns(dc).Offset(0, 1).Delete Shift:=xlToLeft
End Sub |
Partager