Microsoft 365 RÉSOLU Multi ligne selon critère cellule

Sub diviser()
Dim derlig&, t, j&, jsup&, i&, k&, m&, s
With Sheets("Adherents_F78019")
   If .FilterMode Then .ShowAllData
   derlig = .Cells(.Rows.Count, "b").End(xlUp).Row
   t = Application.Transpose(.Range("a1:z" & derlig).Value)
   jsup = UBound(t, 2)
   For j = 2 To jsup
      s = Split(t(26, j), "-")
      If UBound(s) - LBound(s) + 1 > 1 Then
         t(26, j) = Trim(s(0))
         For m = 1 To UBound(s)
            ReDim Preserve t(1 To UBound(t), 1 To UBound(t, 2) + 1)
            For k = 1 To 25: t(k, UBound(t, 2)) = t(k, j): Next
            t(26, UBound(t, 2)) = Trim(s(m))
         Next m
      End If
   Next j
   t = Application.Transpose(t)
   .Range("a1").Resize(UBound(t), UBound(t, 2)) = t
End With
End Sub

Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, s, j%, n&, k%
tablo = Feuil1.[A1].CurrentRegion.Resize(, 26)
ReDim resu(1 To Rows.Count, 1 To 26)
For i = 2 To UBound(tablo)
    s = Split(tablo(i, 26), "-")
    For j = 0 To UBound(s)
        n = n + 1
        For k = 1 To 25: resu(n, k) = tablo(i, k): Next k
        resu(n, 26) = Trim(s(j))
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2]
    If n Then .Resize(n, 26) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 26).ClearContents 'RAZ en dessous
End With
End Sub

Private Sub Worksheet_Activate()
Dim tablo, resu(), i&, s, j%, n&, k%
tablo = Feuil1.[A1].CurrentRegion.Resize(, 26)
ReDim resu(1 To Rows.Count, 1 To 26)
For i = 2 To UBound(tablo)
    s = Split(tablo(i, 26), "-")
    For j = 0 To UBound(s)
        n = n + 1
        For k = 1 To 25
            If IsDate(tablo(i, k)) Then resu(n, k) = CDate(tablo(i, k)) Else resu(n, k) = tablo(i, k) 'convertit les dates (textes) en vraies dates (nombres)
        Next k
        resu(n, 26) = Trim(s(j))
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2]
    If n Then .Resize(n, 26) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 26).ClearContents 'RAZ en dessous
End With
End Sub