Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 16/08/2011, 15h20   #1
Invité de passage
 
Homme olivier
Ingénieur qualité méthodes
Inscription : juillet 2011
Messages : 27
Détails du profil
Informations personnelles :
Nom : Homme olivier

Informations professionnelles :
Activité : Ingénieur qualité méthodes
Secteur : Finance

Informations forums :
Inscription : juillet 2011
Messages : 27
Points : 1
Points : 1
Par défaut Macros sauvegarde / fermeture fichier / ouverture fichier

Bonjour à tous,

Etant novice sur VB, je cherche à avoir une macro qui sauvegarde le fichier Excel en cours, qui ferme le fichier Excel et qui réouvre le fichier quelques instants plus tard, tout cela pour réinitialiser mes différentes variables et objets. Est-ce possible ?
Merci de votre aide

Olivier
olive59 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/08/2011, 16h37   #2
Membre régulier
 
Homme Florian
Étudiant
Inscription : mai 2011
Messages : 44
Détails du profil
Informations personnelles :
Nom : Homme Florian
Âge : 21
Localisation : France, Ille et Vilaine (Bretagne)

Informations professionnelles :
Activité : Étudiant

Informations forums :
Inscription : mai 2011
Messages : 44
Points : 73
Points : 73
Salut à toi,
Pourquoi souhaites-tu impérativement fermer et rouvrir le fichier pour réinitialiser tes variables ? Tu ne peux pas à l'aide d'une macro les réinitialiser directement ?
Ou bien je ne comprends pas bien à quoi tu fais référence...
Orhleil est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/08/2011, 16h53   #3
Invité de passage
 
Homme olivier
Ingénieur qualité méthodes
Inscription : juillet 2011
Messages : 27
Détails du profil
Informations personnelles :
Nom : Homme olivier

Informations professionnelles :
Activité : Ingénieur qualité méthodes
Secteur : Finance

Informations forums :
Inscription : juillet 2011
Messages : 27
Points : 1
Points : 1
Par défaut remise à zero

Bonjour,

Le probléme, c'est que je ne sais pas quelles sont les variables, les objets dans le code suivant. Peux tu m'aider ?
Cordialement

Olivier

'1)CT01

Code :
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
Dim Sh As Worksheet
Dim i As Integer
Dim Rep As String
Dim Res
 
Application.ScreenUpdating = False
Rep = "Z:\Config\Bureau\Apres traitement\CT01"                                                     'Ton répéeroire
Res = ListFichiers(Rep)
Set Sh = ThisWorkbook.Worksheets("feuille")                                                         'La feuille de destination
For i = 1 To UBound(Res)
    Call Transfert(Rep & "\" & Res(i), Sh)
Next i
Set Sh = Nothing
End Sub
Sub Transfert(ByVal FichierCSV As String, Ws As Worksheet)
Dim Wb As Workbook
Dim LastLig As Long, NewLig As Long
 
Application.ScreenUpdating = False
Set Wb = Workbooks.Open(Filename:=FichierCSV, local:=True)
With Wb.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    NewLig = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row + 1
    .Range("A4:A" & LastLig).Copy Ws.Range("A" & NewLig)
    .Range("H4:H" & LastLig).Copy Ws.Range("Z" & NewLig)
    .Range("E4:E" & LastLig).Copy Ws.Range("Y" & NewLig)
    .Range("L4:L" & LastLig).Copy Ws.Range("AA" & NewLig)
    .Range("O4:O" & LastLig).Copy Ws.Range("AB" & NewLig)
    '...etc
    '..Report des autres colonnes
    '...etc
    Ws.Range("A:A").NumberFormat = "[$-F400]h:mm:ss AM/PM"
End With
Wb.Close False
Set Wb = Nothing
End Sub
 
 
'Lister les fichiers triées
Function ListFichiers(ByVal Chemin As String) As String()
Dim i As Integer
Dim Fichier As String, Tb() As String
 
Fichier = Dir(Chemin & "\*.csv")
Do While Fichier <> ""
    i = i + 1
    ReDim Preserve Tb(1 To i)
    Tb(i) = Fichier
    Fichier = Dir
Loop
 
If i > 0 Then Quicksort Tb, 1, i
ListFichiers = Tb
End Function
'Sub de tri rapide
Sub Quicksort(T() As String, ByVal LoBound As Long, ByVal UpBound As Long)
Dim Hi As Integer, Lo As Integer, i As Integer
Dim Med As String
 
If LoBound >= UpBound Then Exit Sub
i = Int((UpBound - LoBound + 1) * Rnd + LoBound)
Med = T(i)
T(i) = T(LoBound)
Lo = LoBound
Hi = UpBound
Do
    Do While T(Hi) >= Med
        Hi = Hi - 1
        If Hi <= Lo Then Exit Do
    Loop
    If Hi <= Lo Then
        T(Lo) = Med
        Exit Do
    End If
    T(Lo) = T(Hi)
    Lo = Lo + 1
    Do While T(Lo) < Med
        Lo = Lo + 1
        If Lo >= Hi Then Exit Do
    Loop
    If Lo >= Hi Then
        Lo = Hi
        T(Hi) = Med
        Exit Do
    End If
    T(Hi) = T(Lo)
Loop
Quicksort T(), LoBound, Lo - 1
Quicksort T(), Lo + 1, UpBound
End Sub
olive59 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/08/2011, 16h57   #4
Expert Confirmé Sénior
 
Avatar de jfontaine
 
Homme Jérôme FONTAINE
Contrôleur de Gestion
Inscription : juin 2006
Messages : 3 885
Détails du profil
Informations personnelles :
Nom : Homme Jérôme FONTAINE
Âge : 38
Localisation : France, Sarthe (Pays de la Loire)

Informations professionnelles :
Activité : Contrôleur de Gestion

Informations forums :
Inscription : juin 2006
Messages : 3 885
Points : 7 151
Points : 7 151
Bonjour,

A noter que ce code ne sera pas dans le classeur puisqu'il devra relancer ce dernier après l'avoir fermé

Le mieux est de réinitialiser tes variables classeur ouvert comme te le suggère Orhleil

Cela étant dit, ce code fait cela, mais il sera a placer dans un autre classeur (le mieux, a mon avis, étant le classeur de macros personnelles)
Code :
1
2
3
4
5
6
7
8
9
Sub reinit()
Dim strName As String
 
ActiveWorkbook.Save
strName = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
ActiveWorkbook.Close
Application.Workbooks.Open strName
 
End Sub
__________________
Jérôme

Citation:
"Ils ne savaient pas que c'était impossible, alors ils l'ont fait" - Marc Twain
Si la réponse répond à votre besoin, votre vote nous encouragera.
Dans le cas ou la réponse mérite, à vos yeux, un , nous faire partager la raison de ce vote, pourrait nous permettre de nous améliorer.
jfontaine est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/08/2011, 17h11   #5
Invité de passage
 
Homme olivier
Ingénieur qualité méthodes
Inscription : juillet 2011
Messages : 27
Détails du profil
Informations personnelles :
Nom : Homme olivier

Informations professionnelles :
Activité : Ingénieur qualité méthodes
Secteur : Finance

Informations forums :
Inscription : juillet 2011
Messages : 27
Points : 1
Points : 1
Par défaut remise à zero

Bonjour Jerôme,

Merci pour ce code mais cela ferme mes feuilles Excel. Connaitrais tu une façon simple de réinitialiser toutes les variables et autres, car je dois utiliser le code précedent à plusieurs reprises ?
Je te remercie de ton aide.

Cordialement

Olivier
olive59 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/08/2011, 17h16   #6
Expert Confirmé Sénior
 
Avatar de jfontaine
 
Homme Jérôme FONTAINE
Contrôleur de Gestion
Inscription : juin 2006
Messages : 3 885
Détails du profil
Informations personnelles :
Nom : Homme Jérôme FONTAINE
Âge : 38
Localisation : France, Sarthe (Pays de la Loire)

Informations professionnelles :
Activité : Contrôleur de Gestion

Informations forums :
Inscription : juin 2006
Messages : 3 885
Points : 7 151
Points : 7 151
As tu essayé de relancer CT01
__________________
Jérôme

Citation:
"Ils ne savaient pas que c'était impossible, alors ils l'ont fait" - Marc Twain
Si la réponse répond à votre besoin, votre vote nous encouragera.
Dans le cas ou la réponse mérite, à vos yeux, un , nous faire partager la raison de ce vote, pourrait nous permettre de nous améliorer.
jfontaine est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/08/2011, 17h18   #7
Membre régulier
 
Homme Florian
Étudiant
Inscription : mai 2011
Messages : 44
Détails du profil
Informations personnelles :
Nom : Homme Florian
Âge : 21
Localisation : France, Ille et Vilaine (Bretagne)

Informations professionnelles :
Activité : Étudiant

Informations forums :
Inscription : mai 2011
Messages : 44
Points : 73
Points : 73
Rebonjour,
Lorsque tu postes du code, essaie d'utiliser la balise CODE (représentée par un # dans la panneau d'écriture du message), ce qui fait apparaitre le code comme dans le message de jfontaine, ce qui est nettement plus lisible.
Qui plus est il manque un petit bout de ton code en haut (la déclaration de la procédure seulement je pense, mais ça peut être important si c'est un évènement ^^)

Sinon j'ai essayé de passer un peu en revue le code, je vois pas trop ce que tu veux réinitialiser en fait...

EDIT : j'ai été très lent à écrire ce message u_u
Oui comme le dit jfontaine, je pense simplement que tu as besoin de relancer CT01, la déclaration des variables est correcte dans les procédures, l'utilisation des objets aussi. Ca ne devrait pas poser de problème
Orhleil est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 16/08/2011, 18h08   #8
Invité de passage
 
Homme olivier
Ingénieur qualité méthodes
Inscription : juillet 2011
Messages : 27
Détails du profil
Informations personnelles :
Nom : Homme olivier

Informations professionnelles :
Activité : Ingénieur qualité méthodes
Secteur : Finance

Informations forums :
Inscription : juillet 2011
Messages : 27
Points : 1
Points : 1
Par défaut Remise à zero

Rebonjour

Merci pour ta réponse. Connaitrais tu une façon simple de réinitialiser toutes les variables et autres, car je dois utiliser le code précedent à plusieurs reprises ?
Je te remercie de ton aide.

Cordialement

Olivier
olive59 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 17/08/2011, 10h26   #9
Membre régulier
 
Homme Florian
Étudiant
Inscription : mai 2011
Messages : 44
Détails du profil
Informations personnelles :
Nom : Homme Florian
Âge : 21
Localisation : France, Ille et Vilaine (Bretagne)

Informations professionnelles :
Activité : Étudiant

Informations forums :
Inscription : mai 2011
Messages : 44
Points : 73
Points : 73
Salut,
Je ne vois vraiment pas quelles variables tu veux réinitialiser. Normalement en relançant plusieurs fois ton code, tout devrait aller. Rien à réinitialiser ici...
D'après ce que je comprends ta procédure principale c'est la première, celle dont il manque la déclaration sur ton copier/coller mais avec le 'CT01 en haut. Quand tu relances plusieurs fois cette macro tu as une erreur ?

EDIT : ah je viens de réaliser, si tu n'as pas cette fameuse déclaration de procédure, les variables déclarées sont des variables globales, et du coup effectivement il doit les garder en mémoire.
Essaie de rajouter une déclaration de procédure en haut, par exemple :
Code :
1
2
3
4
5
6
Public Sub MacroPrincipale()
Dim Sh As Worksheet
Dim i As Integer
Dim Rep As String
Dim Res
'(reste du code)
Et du coup pour réutiliser ton code tu n'auras plus qu'à lancer autant de fois que tu veux la procédure "MacroPrincipale".
Orhleil est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 17/08/2011, 16h16   #10
Invité de passage
 
Homme olivier
Ingénieur qualité méthodes
Inscription : juillet 2011
Messages : 27
Détails du profil
Informations personnelles :
Nom : Homme olivier

Informations professionnelles :
Activité : Ingénieur qualité méthodes
Secteur : Finance

Informations forums :
Inscription : juillet 2011
Messages : 27
Points : 1
Points : 1
Par défaut remise à zero des variables

Bonjour

Merci pour ta réponse et ton code. Mais cela ne m'affiche pas les valeurs. Il y a peut être un pb ailleurs, quelqu'un aurait il une idée ?. Je remets mon code entièrement en dessous. Merci

Cordialement

Olivier

Code :
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
 
Sub un()
 
 
'1)CT01
 
Dim Sh As Worksheet
Dim i As Integer
Dim Rep As String
Dim Res
 
Application.ScreenUpdating = False
Rep = "Z:\Config\Bureau\Apres traitement\CT01"                                                     'Ton répéeroire
Res = ListFichiers(Rep)
Set Sh = ThisWorkbook.Worksheets("feuille")                                                        'La feuille de destination
For i = 1 To UBound(Res)
    Call Transfert(Rep & "\" & Res(i), Sh)
Next i
Set Sh = Nothing
End Sub
Sub Transfert(ByVal FichierCSV As String, Ws As Worksheet)
Dim Wb As Workbook
Dim LastLig As Long, NewLig As Long
 
Application.ScreenUpdating = False
Set Wb = Workbooks.Open(Filename:=FichierCSV, local:=True)
With Wb.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    NewLig = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row + 1
    .Range("A4:A" & LastLig).Copy Ws.Range("A" & NewLig)
    .Range("H4:H" & LastLig).Copy Ws.Range("Z" & NewLig)
    .Range("E4:E" & LastLig).Copy Ws.Range("Y" & NewLig)
    .Range("L4:L" & LastLig).Copy Ws.Range("AA" & NewLig)
    .Range("O4:O" & LastLig).Copy Ws.Range("AB" & NewLig)
    '...etc
    '..Report des autres colonnes
    '...etc
    Ws.Range("A:A").NumberFormat = "[$-F400]h:mm:ss AM/PM"
End With
Wb.Close False
Set Wb = Nothing
End Sub
 
 
'Lister les fichiers triées
Function ListFichiers(ByVal Chemin As String) As String()
Dim i As Integer
Dim Fichier As String, Tb() As String
 
Fichier = Dir(Chemin & "\*.csv")
Do While Fichier <> ""
    i = i + 1
    ReDim Preserve Tb(1 To i)
    Tb(i) = Fichier
    Fichier = Dir
Loop
 
If i > 0 Then Quicksort Tb, 1, i
ListFichiers = Tb
End Function
'Sub de tri rapide
Sub Quicksort(T() As String, ByVal LoBound As Long, ByVal UpBound As Long)
Dim Hi As Integer, Lo As Integer, i As Integer
Dim Med As String
 
If LoBound >= UpBound Then Exit Sub
i = Int((UpBound - LoBound + 1) * Rnd + LoBound)
Med = T(i)
T(i) = T(LoBound)
Lo = LoBound
Hi = UpBound
Do
    Do While T(Hi) >= Med
        Hi = Hi - 1
        If Hi <= Lo Then Exit Do
    Loop
    If Hi <= Lo Then
        T(Lo) = Med
        Exit Do
    End If
    T(Lo) = T(Hi)
    Lo = Lo + 1
    Do While T(Lo) < Med
        Lo = Lo + 1
        If Lo >= Hi Then Exit Do
    Loop
    If Lo >= Hi Then
        Lo = Hi
        T(Hi) = Med
        Exit Do
    End If
    T(Hi) = T(Lo)
Loop
Quicksort T(), LoBound, Lo - 1
Quicksort T(), Lo + 1, UpBound
End Sub
 
'2)CT03
'Création d'une sous directory CT03bis
Sub deux()
MkDir "Z:\Config\Bureau\Apres traitement\CT03bis"
End Sub
 
'Déplacer les fichiers dans CT03bis
Sub trois()
 
Dim Fso As Object
Dim FsoRepertoire As Object
Dim FsoFichier As Object
 
Dim strRepertoire As String
 
strRepertoire = ThisWorkbook.Path
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRepertoire = Fso.GetFolder(ThisWorkbook.Path & "\CT03")
 
'Boucle sur fichiers du repertoire
For Each FsoFichier In FsoRepertoire.Files
  If Left$(FsoFichier.Name, 10) = "CT3__T1A-7" Then
    FsoFichier.Copy strRepertoire & "\CT03\" & FsoFichier.Name, True
    FsoFichier.Move strRepertoire & "\CT03bis\" & FsoFichier.Name
  End If
Next
 
 
 
End Sub
 
 
Public Sub MacroPrincipale()
Dim Sh As Worksheet
Dim i As Integer
Dim Rep As String
Dim Res
'(reste du code) 'coller les colonnes sur fichier excel
 
 
Application.ScreenUpdating = False
Rep = "Z:\Config\Bureau\Apres traitement\CT03"                                                     'Ton répéeroire
Res = ListFichiers(Rep)
Set Sh = ThisWorkbook.Worksheets("feuille")                                                        'La feuille de destination
For i = 1 To UBound(Res)
    Call Transfert(Rep & "\" & Res(i), Sh)
Next i
Set Sh = Nothing
End Sub
Sub Transfert1(ByVal FichierCSV As String, Ws As Worksheet)
Dim Wb As Workbook
Dim LastLig As Long, NewLig As Long
 
Application.ScreenUpdating = False
Set Wb = Workbooks.Open(Filename:=FichierCSV, local:=True)
With Wb.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    NewLig = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row + 1
    .Range("E4:E" & LastLig).Copy Ws.Range("AI" & NewLig)
    .Range("H4:H" & LastLig).Copy Ws.Range("AJ" & NewLig)
    .Range("L4:L" & LastLig).Copy Ws.Range("AK" & NewLig)
    .Range("O4:O" & LastLig).Copy Ws.Range("AL" & NewLig)
    .Range("S4:S" & LastLig).Copy Ws.Range("AM" & NewLig)
    .Range("V4:V" & LastLig).Copy Ws.Range("AN" & NewLig)
    '...etc
    '..Report des autres colonnes
    '...etc
    Ws.Range("A:A").NumberFormat = "[$-F400]h:mm:ss AM/PM"
End With
Wb.Close False
Set Wb = Nothing
End Sub
 
 
'Lister les fichiers triées
Function ListFichiers1(ByVal Chemin As String) As String()
Dim i As Integer
Dim Fichier As String, Tb() As String
 
Fichier = Dir(Chemin & "\*.csv")
Do While Fichier <> ""
    i = i + 1
    ReDim Preserve Tb(1 To i)
    Tb(i) = Fichier
    Fichier = Dir
Loop
 
If i > 0 Then Quicksort Tb, 1, i
ListFichiers = Tb
End Function
'Sub de tri rapide
Sub Quicksort1(T() As String, ByVal LoBound As Long, ByVal UpBound As Long)
Dim Hi As Integer, Lo As Integer, i As Integer
Dim Med As String
 
If LoBound >= UpBound Then Exit Sub
i = Int((UpBound - LoBound + 1) * Rnd + LoBound)
Med = T(i)
T(i) = T(LoBound)
Lo = LoBound
Hi = UpBound
Do
    Do While T(Hi) >= Med
        Hi = Hi - 1
        If Hi <= Lo Then Exit Do
    Loop
    If Hi <= Lo Then
        T(Lo) = Med
        Exit Do
    End If
    T(Lo) = T(Hi)
    Lo = Lo + 1
    Do While T(Lo) < Med
        Lo = Lo + 1
        If Lo >= Hi Then Exit Do
    Loop
    If Lo >= Hi Then
        Lo = Hi
        T(Hi) = Med
        Exit Do
    End If
    T(Hi) = T(Lo)
Loop
Quicksort T(), LoBound, Lo - 1
Quicksort T(), Lo + 1, UpBound
End Sub
olive59 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 18/08/2011, 10h19   #11
Invité de passage
 
Homme olivier
Ingénieur qualité méthodes
Inscription : juillet 2011
Messages : 27
Détails du profil
Informations personnelles :
Nom : Homme olivier

Informations professionnelles :
Activité : Ingénieur qualité méthodes
Secteur : Finance

Informations forums :
Inscription : juillet 2011
Messages : 27
Points : 1
Points : 1
Par défaut Remise à zéro

Bonjour,

Je ne sais pas pourquoi, ce code m'importe seulement le premier fichier en date, quelqu'un aurait il une idée ?

Cordialement

Olivier

Code :
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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
 
Sub un()
'1)CT01
 
Dim Sh As Worksheet
Dim i As Integer
Dim Rep As String
Dim Res
 
Application.ScreenUpdating = False
Rep = "Z:\Config\Bureau\Apres traitement\CT01"                                                     'Ton répéeroire
Res = ListFichiers(Rep)
Set Sh = ThisWorkbook.Worksheets("feuille")                                                        'La feuille de destination
For i = 1 To UBound(Res)
    Call Transfert(Rep & "\" & Res(i), Sh)
Next i
Set Sh = Nothing
End Sub
Sub Transfert(ByVal FichierCSV As String, Ws As Worksheet)
Dim Wb As Workbook
Dim LastLig As Long, NewLig As Long
 
Application.ScreenUpdating = False
Set Wb = Workbooks.Open(Filename:=FichierCSV, local:=True)
With Wb.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    NewLig = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row + 1
    .Range("A4:A" & LastLig).Copy Ws.Range("A" & NewLig)
    .Range("H4:H" & LastLig).Copy Ws.Range("Z" & NewLig)
    .Range("E4:E" & LastLig).Copy Ws.Range("Y" & NewLig)
    .Range("L4:L" & LastLig).Copy Ws.Range("AA" & NewLig)
    .Range("O4:O" & LastLig).Copy Ws.Range("AB" & NewLig)
    '...etc
    '..Report des autres colonnes
    '...etc
    Ws.Range("A:A").NumberFormat = "[$-F400]h:mm:ss AM/PM"
End With
Wb.Close False
Set Wb = Nothing
End Sub
 
 
'Lister les fichiers triées
Function ListFichiers(ByVal Chemin As String) As String()
Dim i As Integer
Dim Fichier As String, Tb() As String
 
Fichier = Dir(Chemin & "\*.csv")
Do While Fichier <> ""
    i = i + 1
    ReDim Preserve Tb(1 To i)
    Tb(i) = Fichier
    Fichier = Dir
Loop
 
If i > 0 Then Quicksort Tb, 1, i
ListFichiers = Tb
End Function
'Sub de tri rapide
Sub Quicksort(T() As String, ByVal LoBound As Long, ByVal UpBound As Long)
Dim Hi As Integer, Lo As Integer, i As Integer
Dim Med As String
 
If LoBound >= UpBound Then Exit Sub
i = Int((UpBound - LoBound + 1) * Rnd + LoBound)
Med = T(i)
T(i) = T(LoBound)
Lo = LoBound
Hi = UpBound
Do
    Do While T(Hi) >= Med
        Hi = Hi - 1
        If Hi <= Lo Then Exit Do
    Loop
    If Hi <= Lo Then
        T(Lo) = Med
        Exit Do
    End If
    T(Lo) = T(Hi)
    Lo = Lo + 1
    Do While T(Lo) < Med
        Lo = Lo + 1
        If Lo >= Hi Then Exit Do
    Loop
    If Lo >= Hi Then
        Lo = Hi
        T(Hi) = Med
        Exit Do
    End If
    T(Hi) = T(Lo)
Loop
Quicksort T(), LoBound, Lo - 1
Quicksort T(), Lo + 1, UpBound
End Sub
 
'2)CT03
'Création d'une sous directory CT03bis
Sub deux()
MkDir "Z:\Config\Bureau\Apres traitement\CT03bis"
End Sub
 
'Déplacer les fichiers dans CT03bis
Sub trois()
 
Dim Fso As Object
Dim FsoRepertoire As Object
Dim FsoFichier As Object
 
Dim strRepertoire As String
 
strRepertoire = ThisWorkbook.Path
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRepertoire = Fso.GetFolder(ThisWorkbook.Path & "\CT03")
 
'Boucle sur fichiers du repertoire
For Each FsoFichier In FsoRepertoire.Files
  If Left$(FsoFichier.Name, 10) = "CT3__T1A-7" Then
    FsoFichier.Copy strRepertoire & "\CT03\" & FsoFichier.Name, True
    FsoFichier.Move strRepertoire & "\CT03bis\" & FsoFichier.Name
  End If
Next
 
 
 
End Sub
 
'coller les colonnes sur fichier excel
 
Public Sub quatre()
Dim Sh As Worksheet
Dim i As Integer
Dim Rep As String
Dim Res
'(reste du code)
 
 
Application.ScreenUpdating = False
Rep = "Z:\Config\Bureau\Apres traitement\CT03"                                                     'Ton répéeroire
Res = ListFichiersa(Rep)
Set Sh = ThisWorkbook.Worksheets("feuille")                                                        'La feuille de destination
For i = 1 To UBound(Res)
    Call Transferta(Rep & "\" & Res(i), Sh)
Next i
Set Sh = Nothing
End Sub
Sub Transferta(ByVal FichierCSV As String, Ws As Worksheet)
Dim Wb As Workbook
Dim LastLig As Long, NewLig As Long
 
Application.ScreenUpdating = False
Set Wb = Workbooks.Open(Filename:=FichierCSV, local:=True)
With Wb.Worksheets(1)
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    NewLig = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row + 1
    .Range("E4:E" & LastLig).Copy Ws.Range("AI" & NewLig)
    .Range("H4:H" & LastLig).Copy Ws.Range("AJ" & NewLig)
    .Range("L4:L" & LastLig).Copy Ws.Range("AK" & NewLig)
    .Range("O4:O" & LastLig).Copy Ws.Range("AL" & NewLig)
    .Range("S4:S" & LastLig).Copy Ws.Range("AM" & NewLig)
    .Range("V4:V" & LastLig).Copy Ws.Range("AN" & NewLig)
    '...etc
    '..Report des autres colonnes
    '...etc
End With
Wb.Close False
Set Wb = Nothing
End Sub
 
 
'Lister les fichiers triées
Function ListFichiersa(ByVal Chemin As String) As String()
Dim i As Integer
Dim Fichier As String, Tb() As String
 
Fichier = Dir(Chemin & "\*.csv")
Do While Fichier <> ""
    i = i + 1
    ReDim Preserve Tb(1 To i)
    Tb(i) = Fichier
    Fichier = Dir
Loop
 
If i > 0 Then Quicksorta Tb, 1, i
ListFichiersa = Tb
End Function
'Sub de tri rapide
Sub Quicksorta(T() As String, ByVal LoBound As Long, ByVal UpBound As Long)
Dim Hi As Integer, Lo As Integer, i As Integer
Dim Med As String
 
If LoBound >= UpBound Then Exit Sub
i = Int((UpBound - LoBound + 1) * Rnd + LoBound)
Med = T(i)
T(i) = T(LoBound)
Lo = LoBound
Hi = UpBound
Do
    Do While T(Hi) >= Med
        Hi = Hi - 1
        If Hi <= Lo Then Exit Do
    Loop
    If Hi <= Lo Then
        T(Lo) = Med
        Exit Do
    End If
    T(Lo) = T(Hi)
    Lo = Lo + 1
    Do While T(Lo) < Med
        Lo = Lo + 1
        If Lo >= Hi Then Exit Do
    Loop
    If Lo >= Hi Then
        Lo = Hi
        T(Hi) = Med
        Exit Do
    End If
    T(Hi) = T(Lo)
Loop
Quicksorta T(), LoBound, Lo - 1
Quicksorta T(), Lo + 1, UpBound
End Sub
olive59 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 09h25.


 
 
 
 
Partenaires

Hébergement Web