Microsoft 365 Problème pour traiter un fichier csv

Private Sub CommandButton1_Click()
Dim fichier$, d As Object, x%, y$, s, dat As Variant, z$, i&, n&, a(), b()
fichier = ThisWorkbook.Path & "\test export.csv"
Set d = CreateObject("Scripting.Dictionary")
x = FreeFile
Open fichier For Input As #x 'ouverture en lecture séquentielle
While Not EOF(x)
    Line Input #x, y 'récupère la ligne
    y = Replace(y, """,""", ";") 'pour avoir le point-virgule à gauche du nom
    y = Replace(y, """,", ";") 'pour avoir le point-virgule à droite du nom
    s = Split(y, ";")
    dat = Mid(s(0), 2, 10)
    If IsDate(dat) Then
        dat = CDate(dat)
        z = Chr(1) & s(3) & Chr(1) 'nom encadré
        If d.exists(dat) Then
            i = d(dat) 'récupère la ligne
            If InStr(a(3, i), z) = 0 Then
                a(2, i) = a(2, i) + 1 'comptage
                a(3, i) = a(3, i) & z
            End If
        Else
            n = n + 1
            d(dat) = n 'mémorise la ligne
            ReDim Preserve a(1 To 3, 1 To n)
            a(1, n) = dat
            a(2, n) = 1
            a(3, n) = z
        End If
    End If
Wend
Close #x
'---transposition---
If n Then
    ReDim b(1 To n, 1 To 2)
    For i = 1 To n
        b(i, 1) = a(1, i)
        b(i, 2) = a(2, i)
    Next
End If
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination
    If n Then .Resize(n, 2) = b
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub

Sub test()
PressePapier = Replace(Replace(OuvrirFichier(ThisWorkbook.Path & "\export test.csv"), Chr(34), ""), ",", vbTab)
ActiveCell.PasteSpecial xlPasteAll
End Sub
'retourne un fichier texte sous forme de tableau
Private Function OuvrirFichier(Fichier)
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(Fichier)
OuvrirFichier = oFile.ReadAll
oFile.Close
End Function
Public Function ClearPressePapier()
With CreateObject("htmlfile").parentwindow.clipboardData.clearData("Text"): End With
End Function
Public Property Let PressePapier(valeur)
With CreateObject("htmlfile").parentwindow.clipboardData.setData("Text", valeur): End With
End Property

Public Property Get PressePapier()
PressePapier = CreateObject("htmlfile").parentwindow.clipboardData.GetData("TEXT")
End Property

Sub testQ()
    PressePapier = Replace(Replace(OuvrirFichier(ThisWorkbook.Path & "\export test.csv"), Chr(34), ""), ",", vbTab)
    With ActiveSheet
        .UsedRange.Clear
        .Cells(1).PasteSpecial xlPasteAll
        .UsedRange.Cells.Replace "é", "é"
        .UsedRange.EntireColumn.AutoFit
        .Cells(1).Select
    End With
End Sub

Private Sub CommandButton1_Click()
Dim fichier$, d As Object, dd As Object, x%, y$, s, dat As Variant, n&, a(), b(), i&, j&
fichier = ThisWorkbook.Path & "\test export.csv"
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
x = FreeFile
Open fichier For Input As #x 'ouverture en lecture séquentielle
While Not EOF(x)
    Line Input #x, y 'récupère la ligne
    y = Replace(y, """,""", ";") 'pour avoir le point-virgule à gauche du nom
    y = Replace(y, """,", ";") 'pour avoir le point-virgule à droite du nom
    s = Split(y, ";")
    dat = Mid(s(0), 2, 10)
    If IsDate(dat) Then
        dat = CDate(dat)
        If Not d.exists(dat) Then
            n = n + 1
            d(dat) = n 'mémorise la ligne
            ReDim Preserve a(1 To 2, 1 To n)
            a(1, n) = dat
        End If
        dd(dat & s(3)) = ""
    End If
Wend
Close #x
If n Then
    '---complète le tableau a---
    b = dd.keys
    For i = 0 To UBound(b)
        j = d(CDate(Left(b(i), 10))) 'récupère la ligne
        a(2, j) = a(2, j) + 1 'comptage
    Next
    '---transposition---
    ReDim b(1 To n, 1 To 2)
    For i = 1 To n
        b(i, 1) = a(1, i)
        b(i, 2) = a(2, i)
    Next
End If
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination
    If n Then .Resize(n, 2) = b
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).ClearContents 'RAZ en dessous
End With
End Sub