Re : Combiner des lignes
Bonjour,
Une piste avec le code suivant.
J'ai pris les données de votre exemple et j'obtiens le résultat que
vous vouliez avoir.
Les données à traiter doivent, IMPERATIVEMENT, commencées en "A1".
***************
Sub CombinerLignes()
Dim R As Range
Dim var
Dim S As Worksheet
Dim i&
Dim j&
Dim k&
Dim T()
Set R = ActiveSheet.UsedRange
If R.Rows.Count = 1 Or R.Columns.Count = 1 Then Exit Sub
var = R
Set S = Sheets.Add(before:=Sheets(ActiveSheet.Name))
Set R = S.Range(R.Address)
R = var
R.Sort Key1:=[a1], Order1:=xlAscending
var = R
ReDim T(1 To UBound(var, 1), 1 To UBound(var, 2))
k& = 1
For j& = 1 To UBound(var, 2)
T(k&, j&) = var(1, j&)
Next j&
For i& = 2 To UBound(var, 1)
If var(i&, 1) = T(k&, 1) Then
For j& = 2 To UBound(var, 2)
If var(i&, j&) <> T(k&, j&) Then
If IsEmpty(T(k&, j&)) Then T(k&, j&) = var(i&, j&)
End If
Next j&
Else
k& = k& + 1
For j& = 1 To UBound(var, 2)
T(k&, j&) = var(i&, j&)
Next j&
End If
Next i&
R = T
End Sub
***************
Cordialement.
PMO
Patrick Morange