XL pour MAC nettoyage et tri de données

Sub Ventiler()
Dim der&, t, r, i&, j&, n&
   der = Cells(Rows.Count, "a").End(xlUp).Row + 6
   t = Range("a3:a" & der).Value
   ReDim r(1 To UBound(t) / 3, 1 To 6)
   i = 1
   Do
      Do While i <= UBound(t)
         If InStr(t(i, 1), ",") > 0 Then Exit Do
         i = i + 1
      Loop
      If i > UBound(t) Then Exit Do
      n = n + 1
      For j = 1 To 4
         r(n, j) = t(i, 1)
         i = i + 1
      Next j
      If InStr(t(i, 1), "@") > 0 Then r(n, 5) = t(i, 1): i = i + 1
      If InStr(t(i, 1), "+") > 0 Then r(n, 6) = t(i, 1)
   Loop
   Range("b2:g" & Rows.Count).Clear
   If n > 0 Then
      With Range("b2").Resize(n, 6)
         .Value = r
         .Borders.LineStyle = xlContinuous
         .WrapText = True
         .VerticalAlignment = xlVAlignCenter
      End With
   End If
End Sub

Sub Ventiler()
Dim der&, t, r, i&, j&, n&, debut
   debut = Timer
   Application.ScreenUpdating = False
   der = Cells(Rows.Count, "a").End(xlUp).Row + 6
   t = Range("a3:a" & der).Value
   ReDim r(1 To UBound(t) / 3, 1 To 6)
   i = 1
   Do
      Do While i <= UBound(t)
         If InStr(t(i, 1), ",") > 0 Then Exit Do
         i = i + 1
      Loop
      If i > UBound(t) Then Exit Do
      n = n + 1
      For j = 1 To 4
         r(n, j) = t(i, 1)
         i = i + 1
      Next j
      If InStr(t(i, 1), "@") > 0 Then r(n, 5) = t(i, 1): i = i + 1
      If InStr(t(i, 1), "+") > 0 Then r(n, 6) = t(i, 1)
   Loop
   Range("b2:g" & Rows.Count).Clear
   If n > 0 Then
      With Range("b2").Resize(n, 6)
         .Value = r
         .Borders.LineStyle = xlContinuous
         .EntireColumn.AutoFit
      End With
   End If
   Application.Goto [a1], True
   MsgBox "Durée : " & Format(Timer - debut, "0.00\ sec.")
End Sub