Sub Regrouper_Dissocier()
Dim tablo, ncol%, i&, j%, s
With [B3].CurrentRegion 'à adapter
tablo = .Value 'matrice, plus rapide
If IsArray(tablo) Then
ActiveSheet.DrawingObjects(1).Text = "Dissocier"
ncol = UBound(tablo, 2)
For i = 1 To UBound(tablo)
For j = 2 To ncol
tablo(i, 1) = tablo(i, 1) & "-" & tablo(i, j)
tablo(i, j) = ""
Next
If i > 1 Then tablo(1, 1) = tablo(1, 1) & vbLf & tablo(i, 1): tablo(i, 1) = ""
Next
Application.ScreenUpdating = False
.Columns(1).ColumnWidth = 255
.Value = tablo
.Rows.AutoFit
.Columns.AutoFit
Else
ActiveSheet.DrawingObjects(1).Text = "Regrouper"
s = Split(tablo, vbLf)
If UBound(s) = -1 Then Exit Sub
ReDim tablo(UBound(s), 0) 'base 0
For i = 0 To UBound(s)
tablo(i, 0) = s(i)
Next
.Resize(i) = tablo
.Resize(i).TextToColumns .Cells(1), xlDelimited, Other:=True, OtherChar:="-" 'commande Convertir
.CurrentRegion.Columns.AutoFit
End If
End With
End Sub