Discussion :

[taphacr]

Bonjour à tous,

De base, j'ai une macro qui copie certaines données d'un classeur dans deux autres et les enregistre sous format csv afin de les importer dans une base en utilisant pgfutter.

Mais j'ai trouvé qu'il y avait des retours à la ligne dans la base dans chaque champ à la dernière colonne. J'ai pas réussi à le retrouver sur excel en remplaçant le caractère spécial 010 par "".

Voici le code qui permet la copie des données dans d'autres fichiers :

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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
 
Sub mise_en_forme_sgp()
 
Dim j As Integer, nomColonne As Integer, numLigne As Integer, nbColonne As Integer, nbLigne As Integer, tmp As Integer, wBook As Workbook
Dim SampleReg As Workbook
Dim importPath As String
Dim mefPath As String
Dim newDebit As Workbook
Dim newSheet As Worksheet
Dim NewfolderPath As String
Dim FolderName As String
Dim mefUniqueFolder As String
Dim importUniqueFolder As String, test1 As String, test2 As String, test3 As String, test4 As String
 
With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        folder = .SelectedItems(1)
        Err.Clear
End With
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
NewfolderPath = Left(folder, Len(folder) - 13)
FolderName = Right(folder, 8)
 
mefPath = NewfolderPath & "\Comptages_SGP_Mef"
importPath = NewfolderPath & "\Comptages_SGP_Import"
test1 = Dir(mefPath, vbDirectory)
test2 = Dir(importPath, vbDirectory)
 
If test1 = vbNullString And test2 = vbNullString Then
    MkDir mefPath
    MkDir importPath
Else
End If
 
mefUniqueFolder = mefPath & "\" & FolderName
importUniqueFolder = importPath & "\" & FolderName
test3 = Dir(mefUniqueFolder, vbDirectory)
test4 = Dir(importUniqueFolder, vbDirectory)
 
If test3 = vbNullString And test4 = vbNullString Then
    MkDir (mefUniqueFolder)
    MkDir (importUniqueFolder)
Else
End If
 
 
OpenFileName = Dir(folder & "\*.csv", vbReadOnly)
 
Application.DisplayAlerts = False
 
While OpenFileName <> ""
 
    Set wBook = Workbooks.Open(folder & "\" & OpenFileName, Local:=True)
    DoEvents
 
    nbColonne = 0
    nbLigne = 0
 
    nomColonne = 3
    numLigne = 3
 
    tmp = 0
    indicePremVal = 3
    j = 3
 
    While Cells(3, nomColonne) <> ""
        nomColonne = nomColonne + 1
        nbColonne = nbColonne + 1
    Wend
 
    While Cells(numLigne, 3) <> "" 'colonne c ligne dynamique
        numLigne = numLigne + 1
        nbLigne = nbLigne + 1
    Wend
 
    tmp = Cells(indicePremVal - 1, j)
 
    For j = 3 To nbColonne + 2
        For i = 3 To nbLigne + 2
            avantProchaineIteration = Cells(i, j)
            If tmp <= Cells(i, j) Then
                Cells(i, j) = Cells(i, j) - tmp
            Else
                Cells(i, j) = 255 - tmp + Cells(i, j) + 1
            End If
            tmp = avantProchaineIteration
        Next
        Cells(indicePremVal - 1, j) = ""
        tmp = Cells(indicePremVal - 1, j + 1)
    Next
 
    DoEvents
 
    Application.ActiveSheet.Range(Cells(1, 1), Cells(1441, (nbColonne / 2) + 2)).Copy
    Workbooks.Add
    DoEvents
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs importUniqueFolder & "\Debit_" & Left(OpenFileName, Len(OpenFileName) - 15) & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    DoEvents
    ActiveWindow.Close
 
    Application.ActiveWindow.Activate
    Union(Range(Cells(1, 1), Cells(1441, 2)), Range(Cells(1, (nbColonne / 2) + 3), Cells(1441, nbColonne + 2))).Copy
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs importUniqueFolder & "\TO_" & Left(OpenFileName, Len(OpenFileName) - 15) & ".csv", FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    ActiveWindow.Close
 
    Application.ActiveWorkbook.SaveAs fileName:=mefUniqueFolder & "\" & Left(Application.ActiveWorkbook.Name, Len(Application.ActiveWorkbook.Name) - 15) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
 
    OpenFileName = Dir 'Passe au fichier suivant
Wend
 
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
MsgBox "Succès"
 
End Sub

Si quelqu'un pourrait m'aider.

Merci.

[jpvba]

Bonjour,


Voici un code a adapté

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Sub test()
 
 
Range("a:a").Replace what:=Chr(10), replacement:=""
 
 
End Sub

Petit conseil, l'utilisation de l'enregistreur de macro est parfois utile

[taphacr]

Bonjour,

Merci pour votre réponse. J'ai essayé votre solution mais cela n'a pas marché. Le problème ne venait pas vraiment de mon fichier Excel mais de ma base.

J'ai appliquer cette solution dans ma base et c'est résolu.

Merci beaucoup.