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