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
| Application.ScreenUpdating = False
Dim DateArrete As Date
Dim Chemin As String
Dim PrefixeDate As String
Dim Entite As String
Dim EntiteCorrigee As String
Dim ColProcedure As Integer
Dim ColEvenement As Integer
Dim ColCA As Integer
Dim ColMAG As Integer
Dim i As Integer
Dim Ligne_Source As Double
Dim Ligne As Double
'Récupération de la date d'arrêté pour créer nouveau fichier
DateArrete = Sheets("Suivi éxécution des macros").Cells(3, 3)
PrefixeDate = Year(DateArrete) & Month(DateArrete)
'Récupération du répertoire de travail
Chemin = Workbooks(ActiveWorkbook.Name).Path
'Enregistrement du fichier global
ActiveWorkbook.SaveAs Filename:= _
Chemin & "\" & PrefixeDate & "-temp--Extractions.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
Chemin & "\" & PrefixeDate & "-GLOBAL-Extractions.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Dim FichierOriginal As String
Dim FichierCopie As String
For i = 1 To 3
'Prévoir Case avec différentes valeurs
Select Case i
Case Is = 1
Entite = "Société 1"
EntiteCorrigee = "S1"
ColProcedure = 31
ColEvenement = 1
ColCA = 35
ColMAG = 30
Case Is = 2
Entite = "Société 2 "
EntiteCorrigee = "S2"
ColProcedure = 17
ColEvenement = 1
ColCA = 17
ColMAG = 17
Case Is = 3
Entite = "Société 3 "
EntiteCorrigee = "S3"
ColProcedure = 17
ColEvenement = 1
ColCA = 17
ColMAG = 17
End Select
'Suppression des données sources du fichier
Workbooks.Open (FichierCopie)
Ligne_Source = 0
Ligne_Source = Sheets("Export-procedures").Range("a1").End(xlDown).Row
Dim TabProcedure()
Dim TabCA()
Dim TabEvenement()
Dim TabMAG()
ReDim Preserve TabProcedure(1 To Ligne_Source, 1 To 44)
ReDim Preserve TabCA(1 To Ligne_Source, 1 To 44)
ReDim Preserve TabEvenement(1 To Ligne_Source, 1 To 44)
ReDim Preserve TabMAG(1 To Ligne_Source, 1 To 44)
Colonne_Source = 44
For Col = 1 To Colonne_Source
TabProcedure(1, Col) = Sheets("Export-procedures").Cells(1, Col).Value
Next Col
'ONGLET PROCEDURES
Dim LigneTabProcedure As Double
LigneTabProcedure = 2
For Ligne = 1 To Ligne_Source
If Sheets("Export-procedures").Cells(Ligne, ColProcedure) = Entite Then
For Col = 1 To Colonne_Source
TabProcedure(LigneTabProcedure, Col) = Sheets("Export-procedures").Cells(Ligne, Col).Value
Next Col
LigneTabProcedure = LigneTabProcedure + 1
End If
Next Ligne
Sheets("Export-procedures").Select
Selection.ClearContents
For Ligne = 1 To LigneTabProcedure
For Col = 1 To Colonne_Source
Sheets("Export-procedures").Cells(Ligne, Col).Value = TabProcedure(Ligne, Col)
Next Col
Next Ligne
'ONGLET CAs
Dim LigneTabCA As Double
LigneTabCA = 2
For Ligne = 1 To Ligne_Source
If Sheets("Export-CAs").Cells(Ligne, ColCA) = Entite Then
For Col = 1 To Colonne_Source
TabCA(LigneTabCA, Col) = Sheets("Export-CAs").Cells(Ligne, Col).Value
Next Col
LigneTabCA = LigneTabCA + 1
End If
Next Ligne
Sheets("Export-CAs").Select
Selection.ClearContents
For Ligne = 1 To LigneTabCA
For Col = 1 To Colonne_Source
Sheets("Export-CAs").Cells(Ligne, Col).Value = TabCA(Ligne, Col)
Next Col
Next Ligne |
