Discussion :

[korni184]

Bonjour,

Est-il possible de créer une macro capable de trier un document en fonction des années ?

Si l'on possède un document avec une sheet "Travail" et 9 autres sheets allant respectivement de 2003 à 2009, est-il possible que lorsque je colle mes données dans la sheet "Travail" qu'il puisse détecter l'année sur une ligne et qu'il envoi directement la ligne dans la sheet correspondante.

Merci d'avance pour votre aide

Bonne journée

[mayekeul]

bonjour,

cela manque un peu de détails mais le principe sera le suivant

tu ajoute dans l'évenement change de la feuille "travail' un code dans ce style

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
    Target.EntireRow.Copy Sheets(CStr(Year(Range("A1")))).Range("A1")
End Sub

[korni184]

J'aimerai essayer de vous faire comprendre :

Je possède un certain nombre de ligne de données, elles sont rangées par années (La date se trouve en colone C).
Grâce à une boucle je fais un YEAR sur cette colone, pour la reproduire en R.

J'aimerai rajouter dans ma boucle, ou ajouter une boucle capable de détecter l'année sur la ligne et envoyée la ligne complète ou elle se trouve dans une sheet.

Ce qui fait que si j'ai des données avec des dates telles que : 2003 / 2004 / 2005 sur une même feuille : Je voudrais me retrouver avec les données de 2003 dans la sheet 2003, les données de 2004 dans la sheet de 2004 etc...

Est-ce possible ?

[Potzo]

Dans ta boucle tu peux rajouter quelque chose comme ca :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
dim C as range
For each C in Range("C1:C" & Cells(rows.count,3).end(xlup).row)
   If Year(C) = 2001 Then
       C.entirerow.copy destination:=Worksheets("2001")
   end if
next

[mayekeul]

bonjour,

la ligen de code ci dessous va t'y aider

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
cells(1,3).entirerow.copy sheets(cstr(cells(1,18))).range("A1")

[korni184]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
 
Sub Macro1()
'
' Macro1 Macro
' Macro recorded 10.08.2010 by fd151
'
' Keyboard Shortcut: Ctrl+a
'
 
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
 
Racine = InputBox("Indiquer la racine à traiter (sanstiret) ", "RACINE")
DatesDebutFin = InputBox("Indiquer les années à considérer ", "ANNEES")
 
If DatesDebutFin = "" Then
 
DDebut = 1900
DFin = 2100
 
Else
 
DDebut = Int(Left(DatesDebutFin, 4))
DFin = Int(Right(DatesDebutFin, 4))
 
 
End If
 
Sheets("Travail").Select
 
'Elimination des lignes inutiles
 
Cpt = 0
 
Range("A1").Select
Do Until ActiveCell.Offset(1, 0).Value = "" And ActiveCell.Offset(2, 0).Value = ""
 
ZoneRacine = (Mid(ActiveCell.Value, 12, 3) & Mid(ActiveCell.Value, 16, 3))
 
If ZoneRacine = Racine Then
ZoneAnnee = Year(ActiveCell.Offset(0, 2))
 
If (ZoneAnnee >= DDebut And ZoneAnnee <= DFin) Then
ActiveCell.Offset(0, 13).FormulaR1C1 = "= YEAR(RC[-11])"
ActiveCell.Offset(1, 0).Select
Cpt = Cpt + 1
 
Else
ActiveCell.EntireRow.Delete
End If
 
Else
ActiveCell.EntireRow.Delete
End If
 
Loop
 
ActiveCell.EntireRow.Delete
 
'sortie avec message si rien dans le fichier
 
If Cpt = 0 Then
MsgBox "pas de racine "
Exit Sub
 
End If

Je devrais ajouter vos ou votre bout de code à quel endroit ?

[Potzo]

Ben en fait, ce que j'ai ecrit devrait suffire en fait