[COLOR="DarkSlateGray"]Option Explicit
Sub regroupe()
Dim i As Long, tf As Boolean
Dim oDat(), dDat()
With Sheets("Feuil1").[A1].CurrentRegion
On Error GoTo pas_de_données
oDat = .Resize(.Rows.Count - 1, 3).Offset(1, 0).Value [COLOR="SeaGreen"]'_______________________________A[/COLOR]
On Error GoTo 0
End With
ReDim dDat(1 To 3, 1 To 1)
dDat(1, 1) = oDat(1, 1)
dDat(2, 1) = oDat(1, 2)
For i = 2 To UBound(oDat, 1)
If oDat(i - 1, 1) <> oDat(i, 1) Or oDat(i - 1, 3) <> oDat(i, 2) Then
dDat(3, UBound(dDat, 2)) = oDat(i - 1, 3)
ReDim Preserve dDat(1 To 3, 1 To 1 + UBound(dDat, 2))
dDat(1, UBound(dDat, 2)) = oDat(i, 1)
dDat(2, UBound(dDat, 2)) = oDat(i, 2)
End If
Next i
dDat(3, UBound(dDat, 2)) = oDat(i - 1, 3)
With Sheets("Feuil2")
If IsEmpty(.[A2].Value) Then
Sheets("Feuil1").[A1:C1].Copy Destination:=.[A1:C1]
.[A2].Resize(UBound(dDat, 2), UBound(dDat, 1)).Value = Application.Transpose(dDat)
Else
With .[A1].End(xlDown)
On Error Resume Next
tf = .Value = dDat(1, 1) And .Offset(0, 2).Value = dDat(2, 1)
On Error GoTo 0
If tf Then
dDat(2, 1) = .Offset(0, 1)
.Resize(UBound(dDat, 2), UBound(dDat, 1)).Value = Application.Transpose(dDat)
Else
.Offset(1, 0).Resize(UBound(dDat, 2), UBound(dDat, 1)).Value = Application.Transpose(dDat)
End If
End With
End If
End With
Exit Sub
[COLOR="SeaGreen"]'
'### Gestion des erreurs ###
'[/COLOR]
pas_de_données:
[COLOR="SeaGreen"]'survient si il n'y a pas de données à traiter. (A)[/COLOR]
ReDim oDat(1 To 1, 1 To 3)
Resume Next
End Sub[/COLOR]