Texte déformé lors d'une copie

Bonjour :

J'ai recopié une plage excel à partir d'un fichier fermé(.csv) vers mon classeur actif.

 
Sub Test()

    Dim Tablo()
    Dim x As Integer
    Dim y As Integer

    'définir le chemin et le nom du fichier csv
    Tablo() = Recup("C:\Users\stg_pao\Desktop\", "ExportStat_Global_Synthese.csv")

    For x = 1 To UBound(Tablo, 2)

        For y = 1 To UBound(Tablo, 1)

            Workbooks("Nouveau Feuille Microsoft Office Excel.xlsm").Sheets("Feuil3").Cells(x, y).Value = Tablo(y, x)

        Next y

    Next x

End Sub

Private Sub ConnectCLasseur(ConnectCL As Object, _
                            Dossier As String, _
                            Optional Rs)

    Set ConnectCL = CreateObject("ADODB.Connection")

    If Not IsMissing(Rs) Then Set Rs = CreateObject("ADODB.Recordset")

    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                   "Data Source=" & Dossier & ";" & _
                   "Extended Properties=""text;HDR=YES;FMT=Delimited"""

End Sub

Function Recup(Dossier As String, _
               Classeur As String) As Variant()

    Dim ConnectCL As ADODB.Connection ' Object
    Dim Rs As ADODB.Recordset 'Object
    Dim Champ As Object
    Dim Tbl()
    Dim DerCel As Long
    Dim I As Long
    Dim J As Long

    'ouvre une première connexion pour la recherche
    ConnectCLasseur ConnectCL, Dossier, Rs

    'ouvre pour récupérer les valeurs
    With Rs

        .Open "SELECT * FROM [" & Classeur & "]", ConnectCL, 3, 1, 1
        .MoveFirst

        'stocke les valeurs dans un tableau
        ReDim Tbl(1 To .Fields.Count, _
                  1 To .RecordCount)

        Do While Not .EOF

            I = I + 1

            For Each Champ In .Fields

                J = J + 1
                Tbl(J, I) = Champ.Value

            Next

            J = 0

            .MoveNext

        Loop

    End With

    'ferme la connexion
    ConnectCL.Close

    Recup = Tbl()

End Function

Mais les données sont déformées. Comment on peut faire? Merci d'avance.

L'original et après la copie :

 
#If VBA7 Then
Declare PtrSafe  Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare  PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare PtrSafe  Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare PtrSafe  Function CloseClipboard Lib "User32" () As Long
Declare PtrSafe  Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare PtrSafe  Function EmptyClipboard Lib "User32" () As Long
Declare  PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare  PtrSafe Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#Else
 Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
#End If
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
 Sub test()
Dim Cn As Object, txt As String
Set Cn = CreateObject("Adodb.Connection")
 Cn.Open "Provider =Microsoft.Jet.OLEDB.4.0;Data Source=C:\MyTest\;Extended Properties=""Text;HDR=YES;FMT=Delimited(;);"";"
 Set rs = CreateObject("ADODB.RecordSet")
 rs.Open "select * from [cdfast_clipro8.csv]", Cn
txt = rs.GetString
txt = Replace("" & txt, ";", vbTab)
ClipBoard_SetData "" & txt
ActiveCell.PasteSpecial xlPasteAll
End Sub

Function ClipBoard_SetData(MyString As String)
   Dim hGlobalMemory As Long, lpGlobalMemory As Long
   Dim hClipMemory As Long, X As Long

   ' Allocate moveable global memory.
   '-------------------------------------------
   hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

   ' Lock the block to get a far pointer
   ' to this memory.
   lpGlobalMemory = GlobalLock(hGlobalMemory)

   ' Copy the string to this global memory.
   lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

   ' Unlock the memory.
   If GlobalUnlock(hGlobalMemory) <> 0 Then
      MsgBox "Could not unlock memory location. Copy aborted."
      GoTo OutOfHere2
   End If

   ' Open the Clipboard to copy data to.
   If OpenClipboard(0&) = 0 Then
      MsgBox "Could not open the Clipboard. Copy aborted."
      Exit Function
   End If

   ' Clear the Clipboard.
   X = EmptyClipboard()

   ' Copy the data to the Clipboard.
   hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere2:

   If CloseClipboard() = 0 Then
      MsgBox "Could not close Clipboard."
   End If

   End Function

Voici mon programme. Le seul problème est qu'il traite "," comme un séparateur.

Donc il a séparé certains URLs en deux cellules. Comment on pourrait faire pour résoudre ça?