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 |
Partager