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
| Sub Extraction()
'Suppression du déroulement de la macro à l'écran
Application.ScreenUpdating = False
'Définitions des variables
Dim wk As Workbook
Dim Fichier As String
Dim Nom As String
'Suppresion des alertes
Application.DisplayAlerts = False
'Visibilité de la base Brute activé
Sheets("Base Brute").Visible = True
'Suppression des anciennes données
ThisWorkbook.Sheets(2).Cells.ClearContents
'Ouverture d'un document par l'utilisateur
Fichier = Application.GetOpenFilename(, , "Selection dsu fichier excel", "", "")
'En cas d'annulation de la fenêtre d'importation
If Fichier <> "Faux" Then
Workbooks.Open (Fichier)
End If
If Fichier = "Faux" Then
'Sélection de la base Brut puis activation du mode caché
Sheets("Base Brute").Select
ActiveWindow.SelectedSheets.Visible = False
Sheets("Contrôle").Select
End
End If
'Activation du Fichier
Nom = ActiveWorkbook.Name
Windows(Nom).Activate
'Copie du contenu du document en direction du rapport
For i = 1 To 99
Workbooks(Nom).Sheets(1).Columns(i).Copy ThisWorkbook.Sheets(2).Columns(i)
Next i
'Fermeture du document
Workbooks(Nom).Close
'Sélection de la base Brut puis activation du mode caché
Sheets("Base Brute").Select
Application.CutCopyMode = False
Rows("1:100").Select
Selection.Copy
Sheets("Donnees").Select
Cells.Select
Application.CutCopyMode = False
Selection.ClearContents
Range("A1").Select
Sheets("Base Brute").Select
Selection.Copy
Sheets("Donnees").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False
Range("A1").Select
'Définition des dimensions
Dim var1 As Integer 'nb ligne
'Suppression de la 2ème ligne
Rows("2:2").Select
Rows("2:2").Delete
'Définition de la cellule de calcul temporaire
Range("A1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(C[1])+1"
Range("A1").Select
Selection.Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Suppression de la dernière ligne
var1 = Range("B1").Value
Rows(var1 & ":" & var1).Select
Rows(var1 & ":" & var1).Delete
Range("A1:B1").ClearContents
'Mise en forme
Range("A2").Select
Selection.ClearContents
Columns("A:A").Select
Selection.Delete shift:=xlToLeft
Columns("B:B").Select
Selection.Insert shift:=xlToRight
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
Range("A1").Select
ActiveCell.FormulaR1C1 = "Coulée"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Opération"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Echantillon"
Range("A1").Select
'Saut de ligne entre chaque opération
Dim ligne As Integer
For ligne = 2 To Range("A65536").End(xlUp).Row
If Cells(ligne - 1, "A") <> Cells(ligne, "A") Then Rows(ligne).Insert: ligne = ligne + 1
Next ligne
'On cache la base brute
Sheets("Base Brute").Select
ActiveWindow.SelectedSheets.Visible = False
'Selection du rapport Importé
Sheets("Donnees").Select
'Message de réussite de l'import
MsgBox "Import réussi !"
'Suppression du déroulement de la macro à l'écran
Application.ScreenUpdating = True
End Sub |
