Bonjour,

Je me permets de venir chercher de l'aide sur ce forum.
Je suis très novice en VBA ou tout autre langage et aurais besoin de vos conseils svp.

Je cherche à enregistrer un fichier ebay.csv en ebay.xlsx.

J'ai trouvé sur le net 2 différents codes, en effet, j'arrive bien à convertir un fichier avec les 2 codes, mais dans les 2 cas, je "perds" les 0 qui étaient présents dans le fichier csv.

Je m'explique:
Certaines cellules comportent soient des codes postaux, soit des numéros de téléphone: exemple 06100 ou 06xxxxxxxxx.
Je souhaiterais donc copier exactement cela comme du texte, mais dans le fichier converti en Excel, je me retrouve avec 6100 ou 6xxxxxxx, perte des 0 de devant.

J'ai bien essayé de mettre un format en texte, mais cela ne fonctionne pas.

Quelqu'un aurait-il une idée?

Je vous mets les 2 codes ici:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
 Sub TransformerFichierCsvEnExcel(ByRef fichier As File)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim myPath As String, myFile As String, aa As String
 
myPath = fichier.ParentFolder.Path 'le chemin du fichier csv
myFile = Dir(myPath & "\*.csv")
 
c = 1
Do Until myFile = ""
 
aa = Mid(myFile, 1, Len(myFile) - 4)
ActiveWorkbook.Sheets(1).Columns("AO").Select
ActiveWorkbook.Sheets(1).Columns("AO").NumberFormat = "@"
Workbooks.Open Filename:=myPath & "\" & myFile
ActiveWorkbook.SaveAs Filename:=myPath & "\" & aa & ".xls", FileFormat:=xlExcel8
 
ActiveWorkbook.Close
myFile = Dir
c = c + 1
Loop
 
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub
 
ou
 
Sub ConvertiCvsXls(ByRef fichier As File)
Dim TB
Dim Lig As Long, i As Integer, AncNom As String
 
    myPath = fichier.ParentFolder.Path 'le chemin du fichier csv
    myFile = Dir(myPath & "\*.csv")
    aa = Mid(myFile, 1, Len(myFile) - 4)
 
    Workbooks.Open Filename:=myPath & "/" & myFile
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
        With ActiveSheet
 
        For Lig = 1 To Range("A65536").End(xlUp).Row
'Changer la  , (virgule) par le séparateur de votre fichier
            TB = Split(.Cells(Lig, 1), ",")
 
            For i = 0 To UBound(TB)
 
                .Cells(Lig, i + 1) = TB(i)
                .Cells(Lig, i + 1).NumberFormat = "@"
            Next i
        Next Lig
    End With
 
    ActiveWorkbook.SaveAs Filename:=myPath & "\" & aa & ".xls", FileFormat:=xlExcel8
 
 
        If Dir(chemin & fichier) = "" Then
            'le fichier xls n'existe pas encore
            ActiveWorkbook.SaveAs chemin & fichier, FileFormat:=xlExcel9795 'Jusqu'au 2000
            Workbooks(fichier).Close SaveChanges:=False
        Else
            'le fichier xls existe, voir si ont l'écrase sans tomber en erreur.
            If MsgBox("Le fichier " & myFile & " existe déjà" & Chr(13) _
            & "Faut-il l'écraser ?", vbQuestion + vbYesNo, "Ecraser fichier") = 6 Then
                Application.DisplayAlerts = False
                ActiveWorkbook.SaveAs chemin & fichier, FileFormat:=xlExcel9795 'Jusqu'au 2000
                Workbooks(fichier).Close SaveChanges:=False
                Application.DisplayAlerts = True
            ElseIf Tous Then
                'Eviter la surcharge de classeur si tous les fichiers
                Workbooks(AncNom).Close SaveChanges:=False
            Else
                Application.ScreenUpdating = True
                Application.DisplayAlerts = True
                Exit Sub
            End If
 
    End If
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Merci bcp pour votre aide.
Marion