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
| Sub MoveData()
Dim cell_ori As Range
Dim cell_des As Range
Dim Chemin As String
Dim val As Integer
Dim table(1 To 30, 1 To 3) As Variant
table(1, 1) = "Coca cola"
table(1, 2) = 1337
table(1, 3) = 1338
table(2, 1) = "P&G"
table(2, 2) = 7331
table(2, 3) = 8331
table(3, 1) = "L'oréal"
table(3, 2) = 4
table(3, 3) = 300
Chemin = "C:\Users\mbourgeois\Desktop\récapitulatif.xlsx"
With Worksheets("données")
'Open the destination workbook => pas très propre mais fonctionne
On Error Resume Next
Set Wk = Workbooks("récapitulatif")
If Err <> 0 Then
Err = 0
'MsgBox "Ce fichier est fermé"
Workbooks.Open Chemin
Else
'MsgBox "Ce fichier est ouvert"
End If
Set cell_ori = .Range("A2")
For i = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
If cell_ori.Value <> "" Then
val = 0
For j = 0 To .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row
If .Range("A1").Offset(j, 0).Value = cell_ori.Value Then
val = val + 1
' Else
' Exit For
End If
Next j
Set cell_des = Workbooks("récapitulatif").Worksheets("Recapitulatif").Range("A:A").Find(cell_ori.Value, LookIn:=xlFormulas, lookat:=xlWhole)
If Not cell_des Is Nothing Then
cell_des.Offset(0, 1) = val
Else
Set cell_des = Workbooks("récapitulatif").Worksheets("Recapitulatif").Range("A:A").Find("*", , , , xlByColumns, xlPrevious).Offset(1, 0)
cell_des = cell_ori
cell_des.Offset(0, 1) = val
End If
Set cell_ori = cell_ori.Offset(val, 0)
Else
Set cell_ori = cell_ori.Offset(1, 0)
End If
Next i
End With
With Workbooks("récapitulatif").Worksheets("Recapitulatif")
Set cell_ori = .Range("A1")
For i = 1 To UBound(table)
For j = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
If table(i, 1) = cell_ori.Offset(j, 0) Then
cell_ori.Offset(j, 2) = table(i, 2)
cell_ori.Offset(j, 3) = table(i, 3)
End If
Next j
Next i
End With
'Save and close the Workbook
'Workbooks("récapitulatif").Close True
End Sub |
