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
| Sub AjBnc()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
Dim Trouve As Boolean
Dim Wb As Workbook
Dim Ws As Worksheet
For Each Wb In Application.Workbooks
If Wb.Name Like "Suivi bnc*" Then
Trouve = True
Exit For
End If
Next Wb
If Trouve Then
Set Ws = Wb.Worksheets(1)
i = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
With Ws
.Rows("1:2").Delete
.Range("A2:A" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Rows(Range("B65536").End(xlUp).Row).Delete
.Range("A2:A" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Columns("D").Copy
.Columns("J").PasteSpecial xlPasteValues
.Columns("A:B").Copy
.Columns("F:G").PasteSpecial xlPasteValues
.Range("L:N,E:E,B:B").Delete
.Range("A2:A" & i).Replace What:="*", Replacement:="BNC", LookAt:=xlWhole
.Range("G2:G" & i).Replace What:="*", Replacement:="", LookAt:=xlWhole
.Range("J2:J" & i).Replace What:="*", Replacement:=0, LookAt:=xlWhole
l = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
.Range("K2:K" & l).Formula = "=SUMIFS($I:$I,$D:$D,D2,$H:$H,2)"
.Columns("K").Copy
.Columns("K").PasteSpecial xlPasteValues
.Columns("A:J").Copy
.Columns("L").PasteSpecial xlPasteValues
.Range("V2:V" & l).Formula = "=SUMIFS($I:$I,$D:$D,D2,$H:$H,3)"
.Columns("V").Copy
.Columns("V").PasteSpecial xlPasteValues
.Range("G2:G" & l).Replace What:="*", Replacement:="Manquant", LookAt:=xlWhole
.Range("H2:H" & l).Replace What:="*", Replacement:=2, LookAt:=xlWhole
.Range("R2:R" & l).Replace What:="*", Replacement:="Inversion", LookAt:=xlWhole
.Range("S2:S" & l).Replace What:="*", Replacement:=3, LookAt:=xlWhole
.Range("E2:E" & l).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
.Columns("K").Copy
.Columns("I").PasteSpecial xlPasteValues
.Range("I1").Value = "Nb de ligne de BNC"
.Columns("V").Copy
.Columns("T").PasteSpecial xlPasteValues
m = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
.Range("A" & m + 1 & ":J" & m + m - 1).Value = Range("L2:U" & m).Value
.Columns("K:V").Delete
.Range("I2:I" & m + m - 1).Replace What:=0, Replacement:="", LookAt:=xlWhole
.Range("I2:I" & m + m - 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
n = Range("A" & Rows.Count).End(xlUp).Row
.Range("K2:K" & n).Formula = "=Month((B2))"
.Range("K2:K" & n).Copy
.Range("B2:B" & n).PasteSpecial xlPasteValues
.Columns("B").NumberFormat = "0"
.Columns("K").Delete
End With
k = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row
With ThisWorkbook.Worksheets("MPH")
j = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("L" & j + 1).Formula = "=IFERROR(VLOOKUP(H" & j + 1 & ",BD!$A:$B,2,FALSE),0)"
.Range("M" & j + 1).Formula = "=IFERROR(I" & j + 1 & "/L" & j + 1 & ",0)"
.Range("K" & j + 1 & ":M" & j + 1).Copy
.Range("K" & j + 1 & ":M" & j + k - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Range("A" & j + 1 & ":J" & j + 1 + k).Value = Ws.Range("A2:J" & k + 2).Value
.Range("N" & j + 1).Formula = "=IFERROR(INDEX($C$2:$D$" & j & ",MATCH(D" & j + 1 & ",$D$2:$D$" & j & ",0),1),0)"
.Range("N" & j + 1).Copy
.Range("N" & j + 1 & ":N" & j + k - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Range("N" & j + 1 & ":N" & j + k - 1).Copy
.Range("C" & j + 1 & ":C" & j + k - 1).PasteSpecial xlPasteValues
.Range("N" & j + 1).Formula = "=IFERROR(VLOOKUP(D" & j + 1 & ",$D$2:$F$" & j & ",2,FALSE),"""")"
.Range("N" & j + 1).Copy
.Range("N" & j + 1 & ":N" & j + k - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Range("N" & j + 1 & ":N" & j + k - 1).Copy
.Range("E" & j + 1 & ":E" & j + k - 1).PasteSpecial xlPasteValues
.Range("N" & j + 1).Formula = "=IFERROR(VLOOKUP(D" & j + 1 & ",$D$2:$F$" & j & ",3,FALSE),"""")"
.Range("N" & j + 1).Copy
.Range("N" & j + 1 & ":N" & j + k - 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.Range("N" & j + 1 & ":N" & j + k - 1).Copy
.Range("F" & j + 1 & ":F" & j + k - 1).PasteSpecial xlPasteValues
.Range("N:N").Delete
End With
Application.ScreenUpdating = True
Else
MsgBox "L'importation des données que vous essayez d'effectuer ne peut être effectuée pour l'une des 4 raisons :" _
& vbCrLf & vbCrLf & "1 - Le fichier Suivi bncxxx n'est pas ouvert" & vbCrLf & _
"2 - Le fichier a un nom diffèrent de Suivi bncxxx" & vbCrLf & _
"3 - Le nom de la requête Infolog a été renommé dans ce cas modifier le nom dans la macro" & vbCrLf & _
"4 - Vous avez ouvert l'application Excel plusieurs fois - N'en ouvrir qu'une seule"
'Etape de Libération d'espace mémoire sur Ws et Wb
Set Ws = Nothing
Set Wb = Nothing
'Correspond au End If de If trouve
End If
End Sub |
