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
| Function Filesname(sPath As String)
Dim v() As String
v = Split(sPath, "\")
Filesname = v(UBound(v))
End Function
Public Sub editSynthese()
Dim j, row_deb, row_fin As Integer
Dim compteur As Long
Dim path As String
Dim Strg_2 As String
Dim Strg_4 As String
Dim Strg_5 As String
Strg_2 = "Anomalies détectées :"
Strg_4 = "Synthèse :"
Strg_5 = "Fin Synthèse"
Dim LFIF() As Variant
'Choix du chemin
path = ActiveWorkbook.path
'mise en place de la liste de fichiers
With Application.FileSearch
.NewSearch
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = False
.LookIn = ActiveWorkbook.path
If .Execute() > 1 Then
a = 0
ReDim Preserve LFIF(.FoundFiles.Count - 1)
'(-1) car array(0) (-1) car ce fichier est déjà ouvert
compteur = .FoundFiles.Count
For i = 1 To compteur
If .FoundFiles(i) <> ActiveWorkbook.FullName Then
LFIF(a) = .FoundFiles(i)
MsgBox LFIF(a)
Worksheets(1).Cells(i, 1) = .FoundFiles(i)
MsgBox Filesname(.FoundFiles(i))
'ouverture des fichiers
Application.DisplayAlerts = False
Workbooks.Open LFIF(a)
a = a + 1
End If
' copie des "Evénements importants" dans fichier cabinet
j = 1
Workbooks(Filesname(.FoundFiles(i))).Activate
Worksheets(1).Activate
row_deb = 1
While Worksheets(1).Cells(row_deb, 1) <> Strg_4
row_deb = row_deb + 1
Wend
row_fin = row_deb + 1
While Worksheets(1).Cells(row_fin, 1) <> Strg_2
row_fin = row_fin + 1
Wend
Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & left(Filesname(.FoundFiles(i)), len(Filesname(.FoundFiles(i)) - 4)
j = j + 1
For k = row_deb + 1 To row_fin - 1
Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
j = j + 1
Next k
Next i
Else
MsgBox ("Aucun autre fichier que celui-ci")
End If
End With
' copie des "Anomalies détectées" dans fichier cabinet
j = j + 2
For i = 1 To compteur
Workbooks(ActiveWorkbook.FullName).Activate
Worksheets(1).Activate
row_deb = 1
While Worksheets(1).Cells(row_deb, 1) <> Strg_2
row_deb = row_deb + 1
Wend
row_fin = row_deb + 1
While Worksheets(1).Cells(row_fin, 1) <> Strg_5
row_fin = row_fin + 1
Wend
Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
j = j + 1
For k = row_deb + 1 To row_fin - 1
Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
j = j + 1
Next k
Next i
' copie des "Anomalies détectées" dans fichier client
j = 1
For i = 1 To compteur
Workbooks(i + 1).Activate
Worksheets(1).Activate
row_deb = 1
While Worksheets(1).Cells(row_deb, 1) <> Strg_2
row_deb = row_deb + 1
Wend
row_fin = row_deb + 1
While Worksheets(1).Cells(row_fin, 1) <> Strg_5
row_fin = row_fin + 1
Wend
Workbooks(ActiveWorkbook.FullName).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
j = j + 1
For k = row_deb + 1 To row_fin - 1
Workbooks(ActiveWorkbook.FullName).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(k, 1)
j = j + 1
Next k
Next i
'fermeture des fichiers
ScreenUpdating = False
For i = 1 To nbFiles
Workbooks(LFIF(i)).Close
Next i
End Sub |
Une macro synthese en VBA sous excel!
Répondre avec citation
Partager