Sub rassemble()
Dim TabIni() As Variant
With ActiveSheet
Fin = .Range("G" & .Rows.Count).End(xlUp).Row
TabIni = .Range("F5:G" & Fin).Value
TailleFinale = WorksheetFunction.CountA(.Range("F5:F" & Fin))
ReDim TabFinal(1 To TailleFinale, 1 To 1)
End With
k = 1
For i = LBound(TabIni, 1) To UBound(TabIni, 1)
If TabIni(i, 1) <> "" Then
TabFinal(k, 1) = TabIni(i, 1)
j = i
While TabIni(j + 1, 1) = "" And j <= Fin - 5
TabFinal(k, 1) = TabFinal(k, 1) & "," & TabIni(j + 1, 2)
j = j + 1
If j = Fin - 4 Then GoTo recopie
Wend
k = k + 1
End If
Next i
recopie:
With Sheets("Feuil2")
.Range("A1").Resize(UBound(TabFinal, 1), UBound(TabFinal, 2)) = TabFinal
.Range("B:B").Clear
End With
End Sub
Sub Concatener()
Dim tablo, resu(), i&, n&
With [F5].CurrentRegion
tablo = .Resize(, 2)
ReDim resu(1 To UBound(tablo), 1 To 1)
For i = 1 To UBound(tablo)
If tablo(i, 1) <> "" Then n = n + 1: resu(n, 1) = tablo(i, 1)
If n Then resu(n, 1) = resu(n, 1) & tablo(i, 2)
Next
Application.ScreenUpdating = False
If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
.ClearContents 'RAZ
If n Then .Resize(n, 1) = resu 'restitution
With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
End Sub