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
| Sub Archivage()
'
' Archivage Macro
Sheets("TdP").Select
Dim I As Long
Dim Plage As Range
Set Plage = Range("k100:k10")
For I = Plage.Cells.Count To 1 Step -1
If Plage.Cells(I).Value = "" Then
Plage.Cells(I).EntireRow.Delete
End If
Next
Dim repere As String
Sheets("Archivage").Select
If Range("k4") = "" Then
repere = "j7"
Else: repere = Range("k4").Value
repere = Range(repere).Offset(0, 4).Address 'décalage du collage de la date
End If
Range("k4").Value = repere
Sheets("TdP").Select
Range("DATE2").Select
Selection.Copy
Sheets("Archivage").Select
Range(repere).Select
Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks _
:=False, Transpose:=False
Dim cellule As String ' dans TdP
Dim valeur As Double 'identifiant
Dim cellarchive As String 'identifiant archive
Dim destination As String 'colonne pesée
Dim ecrit As Boolean
Sheets("TdP").Select
cellule = "c10"
While (Range(cellule).Value <> "")
identifiant = Range(cellule).Value
cellulevaleur = "k" & Right(cellule, Len(cellule) - 1)
cellulefin = "B" & Right(cellule, Len(cellule) - 1)
datenaiss = "D" & Right(cellule, Len(cellule) - 1)
race = "E" & Right(cellule, Len(cellule) - 1)
valeur = Range(cellulevaleur).Value
cellarchive = "c10"
ecrit = False
Sheets("Archivage").Select
While (Range(cellarchive).Value <> "" And ecrit <> True)
If (Range(cellarchive).Value = identifiant) Then
destination = "i" & Right(cellarchive, Len(cellarchive) - 1) 'je souhaite que cette colonne de destination se décale aussi
Range(destination).Value = valeur
ecrit = True
End If
cellarchive = "c" & (Right(cellarchive, Len(cellarchive) - 1) + 1)
Wend
If (ecrit = False) Then
debut = "B" & Right(cellarchive, Len(cellarchive) - 1)
fin = "C" & Right(cellarchive, Len(cellarchive) - 1)
naiss = "d" & Right(cellarchive, Len(cellarchive) - 1)
race = "e" & Right(cellarchive, Len(cellarchive) - 1)
newvaleur = "i" & Right(cellarchive, Len(cellarchive) - 1)
Sheets("TdP").Select
Range(cellule, cellulefin).Copy
Sheets("Archivage").Select
Range(debut).PasteSpecial (xlPasteValues)
Range(newvaleur).Value = valeur
Sheets("TdP").Select
Range(datenaiss, race).Copy
Sheets("Archivage").Select
Range(naiss).PasteSpecial (xlPasteValues)
Range(newvaleur).Value = valeur
End If
cellule = "C" & (Right(cellule, Len(cellule) - 1) + 1)
Sheets("Tdp").Select
Wend
End Sub |
