Discussion :

[korni184]

Bonjour,

J'amerai créer une macro simple qui me permetterai de traiter des documents un par un.

C'est à dire sur un document j'ai un certain nombre de données avec des dates différentes.

J'aimerai juste créer une rupture par année, faire le document et le sauvegarder puis recommencer le traitement et donc faire ca par année.

Sachant que la sauvegarde et le traitement sont déjà automatiser dans les modules.

J'ai un formulaire qui comprends ces données :
--> un numéro
--> une ou des années.

Comment faire ? Passer les années en variable ? et ensuite ?
Je vous met le code de la boucle

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
 
 If DatesDebutFin = "" then
DDebut = 1900
DFin = 2100
 
Else
 
DDebut =Int(Left(DatesDebutFin,4))
DFin =Int(Right(DatesDebutFin,4))
 
End If
 
Sheets("Travail").select
Range("A1").SELECT
 
cpt=0
 
'Elimination des lignes inutiles
 
Do while activecell.value <>""
 
ZoneRacineRef = (Mid(ActiveCell.Value,12,3) &Mid(ActiveCell.value,16,3))
ZoneAnnee= Year (ActiveCell.Offset(0,2))
 
If ZoneRacineRef = RacineRef And (Zoneannee >=DDebut and ZoneAnnee <= Dfin) Then
 
cpt= cpt+1
 
else
 
activecell.entirerow.delete
 
end if
 
loop
 
'sortie avec message si rien dans le fichier
 
if cpt = 0 then
 
msgbox "pas de données pour cette racine"
exit sub
 
end if

Merci d'avance.

Je voudrais simplement passer la ou les années en paramètres.

(Exemple : choix 2003-2009)


2003
-Tri
-Traitement
-Sauvegarde
2004
-Tri
- etc...

Tous automatiser !

[buzz73]

Bonjour,

Tu pourrais mettre un exemple de tes données stp?
Il y a beaucoup de lignes (important pour la méthode à utiliser)?

Astuce:
Si c'est sous forme de tableau, tu pourrais par exemple ajouter une colonne avec l'année.

Idée:
Puis filtrer sur la colonne année.
Copier-coller les données filtrées dans le nouveau classeur, sauvegarder et fermer le classeur.

Le tout dans une boucle qui te créerai directement le classeur avec le bon nom.

[korni184]

Malheureusement, je ne peux pas faire de copier/coller des données.
Mais je peux en faire un bonne exemple :

Chiffre : Date : Year
123456 12/01/2002 2002
123456 12/03/2002 2002
123456 12/01/2003 2003
123456 12/04/2004 2004
123456 12/07/2004 2004
123456 12/01/2005 2005

Si il y a plusieurs codes différents, j'arrive facilement via une MSGbox, supprimer tous ce qui est différent. (Rupture sur le code et sur l'annee)

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
71
72
73
74
75
 
 
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(Letf(DatesDebutFin,4))
DFin = Int(Right(DatesDebutFin,4))
 
 
End if 
 
Sheets("Travail").select
 
'Elimination des lignes inutiles
 
cpt = 0
 
Range("A1").select
Do Until active.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 
 
'ajout dune ligne par annéé
 
range("a1").select
 
do while activecell.value <> ""
AnneeEnCours = Year(ActiveCell.Offset(0,2).Value)
If year(ActiveCell.offset(0,2).value) = Year(ActiveCell.offset(1,2).value) then
 
activecell.offset(1,0).select
 
else
activecell.offset(1,0).select
selection.entirerow.insert
activecell.offset(1,0).select
end if
loop
 
end sub

La colone correspondante au (0,2), c'est à la colonne C c'est la colone des dates, et je fais un YEAR en colone 13. Voila

Je voudrais réussir, à selectionner automatiquement chaque année.

Tri
Selection
Traitement
Sauvegarde
Changement d'annee

Pouvez vous maider ??
Merci

[buzz73]

Tes données sont triées par année croissante et il n'y a pas de lignes vides?

Si c'est le cas alors tu peux utiliser ceci:

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
71
72
73
74
75
    Public Function MaFonction()
    Dim i As Long
    Dim PremiereLigne As Long
    Dim DerniereLigne As Long
    Dim ShS As Worksheet 'Feuille source
    Dim ShD As Worksheet 'Feuille Destination
    Dim AnneeEnCours As Integer
    Dim TitreClasseurAnnée As String
    Dim FinFichier As Boolean
 
    '****************************
    'Initialisation des variables
    '****************************
    TitreClasseurAnnée = "Mes données de "
    'Attribution de la feuille source à la variable ShS
    Set ShS = ThisWorkbook.Sheets("Feuil1")
 
    i = 2
    PremiereLigne = i
    DerniereLigne = i
    FinFichier = False
    'Récupération de l'éventuelle première année à considérer
    If IsNumeric(Cells(i, 13)) Then
        AnneeEnCours = Cells(i, 13)
    End If
 
    Do While Cells(i, 13) <> "" Or (i > 2 And Cells(i, 13) = "") And FinFichier = False
        'Si c'est la fin du fichier => permet d'enregistrer la dernière année puis stop la boucle
        If i > 2 And Cells(i, 13) = "" Then
            FinFichier = True
        End If
        'Si Nouvelle Année à considérer
        If Cells(i, 13) <> AnneeEnCours Then
            DerniereLigne = i - 1
            'Création d'un classeur avec 1 seule feuille
            Set ShD = Workbooks.Add(xlWBATWorksheet).Sheets(1)
 
            '******
            'Titres
            '******
            'Copie des titres
            Application.CutCopyMode = False
            ShS.Activate
            ShS.Range(Cells(1, 1), Cells(1, 13)).Copy
            'Collage des titres
            ShD.Activate
            ShD.Cells(1, 1).PasteSpecial
 
            '*******
            'Données
            '*******
            'Copie des données
            Application.CutCopyMode = False
            ShS.Activate
            ShS.Range(Cells(PremiereLigne, 1), Cells(DerniereLigne, 13)).Copy
            'Collage des données
                ShD.Activate
                ShD.Cells(2, 1).PasteSpecial
            'Nom de la feuille = Année considérée
            ShD.Name = AnneeEnCours
            'Fermeture et sauvegarde du classeur avec le titre du classeur
            ShD.Parent.Close True, TitreClasseurAnnée & AnneeEnCours
 
            'Nouvelle année à considérer
            AnneeEnCours = Cells(i, 13)
            'Nouveau début de sélection
            PremiereLigne = i
        End If
        i = i + 1
    Loop
    '*********************
    'Message d'information
    '*********************
    MsgBox "Traitement terminé avec succès", vbOKOnly + vbInformation, "Fin de traitement"
End Function

[korni184]

Et donc je dois mettre ce code avant le début de ma macro ?

[buzz73]

Tu peux mettre ce code où tu veux, je préfère mettre les fonctions après le programme principal.

Puis dans ton programme, tu appelle la fonction avec

Code :

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

Call MaFonction

Ajoute cette ligne dans ton programme après avoir ajouté la colonne année et supprimé les lignes vides.

[korni184]

Je peux vous envoyer le document ? Sur ce forum ? Car j'ai un problème, il bug sur la fonction CutCopyMode

[buzz73]

Tu peux enlever la ligne

Code :

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

Application.CutCopyMode = False

C'est juste pour gérer le presse-papier.

[korni184]

macro.xls

Je voudrais que chaque année aille dans sa sheet respective.
En faisant CTLR + A une fenêtre apparait, vous pouvez taper "522444" et encore une fois enter.

Voilà

[buzz73]

Je suis désolé mais nous ne pouvons pas ouvrir les fichiers provenant d'Internet où je suis. (sécurité)

Pour utiliser la fonction, ton code doit ressembler à ça

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
'Début du code
 
'Programme principal
Sub MonProgramme
  'Début du code
  '...
  'Ajout de la colonne année
  '...
  'Suppression des années à ne pas prendre en compte (d'après ton programme)
  '...
  'Tri des années par ordre croissant si nécessaire
  '...
 
  'Appel de la fonction MaFonction qui va parcourir la colonne Année (colonne numéro 13) et faire la création des classeurs au fur et à mesure des années rencontrées
  Call MaFonction
 
  'Suite du code si autre chose à faire
  '...
End Sub
 
 
'Fonction pour enregistrer les années par classeurs
Function MaFonction
  'Code
  ...
End Function

Dans le code de MaFonction, éventuellement il faut modifier cette ligne

Code :

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

1
2
'Attribution de la feuille source à la variable ShS
    Set ShS = ThisWorkbook.Sheets("Feuil1")

Car j'ai supposé que le classeur contenant la feuille était le classeur contenant le code: "ThisWorkbook"
Et que la feuille s'appelle "Feuil1"

[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
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
 
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
 
 
 
'ajout dune ligne par annéé
 
Range("a1").Select
 
Do While ActiveCell.Value <> ""
AnneeEnCours = Year(ActiveCell.Offset(0, 2).Value)
If Year(ActiveCell.Offset(0, 2).Value) = Year(ActiveCell.Offset(1, 2).Value) Then
 
ActiveCell.Offset(1, 0).Select
 
Else
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
ActiveCell.Offset(1, 0).Select
End If
Loop
 
 
Call MaFonction
 
 
End Sub
 
 
 Public Function MaFonction()
    Dim i As Long
    Dim PremiereLigne As Long
    Dim DerniereLigne As Long
    Dim ShS As Worksheet 'Feuille source
    Dim ShD As Worksheet 'Feuille Destination
    Dim AnneeEnCours As Integer
    Dim TitreClasseurAnnée As String
    Dim FinFichier As Boolean
 
    '****************************
    'Initialisation des variables
    '****************************
    TitreClasseurAnnée = "Mes données de "
    'Attribution de la feuille source à la variable ShS
    Set ShS = ThisWorkbook.Sheets("Travail")
 
    i = 2
    PremiereLigne = i
    DerniereLigne = i
    FinFichier = False
    'Récupération de l'éventuelle première année à considérer
    If IsNumeric(Cells(i, 13)) Then
        AnneeEnCours = Cells(i, 13)
    End If
 
    Do While Cells(i, 13) <> "" Or (i > 2 And Cells(i, 13) = "") And FinFichier = False
        'Si c'est la fin du fichier => permet d'enregistrer la dernière année puis stop la boucle
        If i > 2 And Cells(i, 13) = "" Then
            FinFichier = True
        End If
        'Si Nouvelle Année à considérer
        If Cells(i, 13) <> AnneeEnCours Then
            DerniereLigne = i - 1
            'Création d'un classeur avec 1 seule feuille
            Set ShD = Workbooks.Add(xlWBATWorksheet).Sheets(1)
 
            '******
            'Titres
            '******
            'Copie des titres
            Application.CutCopyMode = False
            ShS.Activate
            ShS.Range(Cells(1, 1), Cells(1, 13)).Copy
            'Collage des titres
            ShD.Activate
            ShD.Cells(1, 1).PasteSpecial
 
            '*******
            'Données
            '*******
            'Copie des données
            Application.CutCopyMode = False
            ShS.Activate
            ShS.Range(Cells(PremiereLigne, 1), Cells(DerniereLigne, 13)).Copy
            'Collage des données
                ShD.Activate
                ShD.Cells(2, 1).PasteSpecial
            'Nom de la feuille = Année considérée
            ShD.Name = AnneeEnCours
            'Fermeture et sauvegarde du classeur avec le titre du classeur
            ShD.Parent.Close True, TitreClasseurAnnée & AnneeEnCours
 
            'Nouvelle année à considérer
            AnneeEnCours = Cells(i, 13)
            'Nouveau début de sélection
            PremiereLigne = i
        End If
        i = i + 1
    Loop
    '*********************
    'Message d'information
    '*********************
    MsgBox "Traitement terminé avec succès", vbOKOnly + vbInformation, "Fin de traitement"
End Function

J'ai pourtant essayer, mais les données ne fonctionnent pas

Voici les données
AA11 1122 3344 5566 7788 TRAIN 31.12.2008 104588,21 ART 123,25 123,25 0 0 0 0 NON
AA11 1122 3344 5566 7789 TRAIN 31.12.2009 10522,33 ART 111,11 111,11 0 0 0 0 NON

AA22 3344 5566 7788 9900 TRAIN 31.12.2008 12154,12 ART 145,45 145,45 0 0 0 0 NON
AA22 3344 5566 7788 9901 TRAIN 31.12.2009 13452,12 ART 147,00 147,00 0 0 0 0 NON

QQ33 4422 5522 4444 1234 CCAQ 31.12.2002 12354,5 ART 457 457 0 0 0 0 NON
QQ33 4422 5522 4444 1235 CCAQ 31.12.2003 12474,5 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1236 CCAQ 31.12.2004 13456,4 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1237 CCAQ 31.12.2005 12354,4 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1238 CCAQ 31.12.2006 15451,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1239 CCAQ 31.12.2007 44511,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1240 CCAQ 31.12.2008 45116,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1241 CCAQ 31.12.2009 15415,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1242 CCAQ 31.12.2010 15451,2 ART 0 0 0 0 0 0 NON

WE44 4444 1111 2222 3333 CCAQ 31.12.2002 454545,5 ART 0 0 0 0 0 0 NON
WE44 4444 1111 2222 3334 CCAQ 31.12.2003 12121,2 ART 0 0 0 0 0 0 NON



Et si je sélectionne : 522 444 : je voudrais juste que chacune des années tombent dans sa sheet respective : 2006 dans la sheet 2006

[buzz73]

Et si tu essaies ça?

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
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
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
 
 
 
 
Call MaFonction
 
 
End Sub
 
 
 Public Function MaFonction()
    Dim i As Long
    Dim PremiereLigne As Long
    Dim DerniereLigne As Long
    Dim ShS As Worksheet 'Feuille source
    Dim ShD As Worksheet 'Feuille Destination
    Dim AnneeEnCours As Integer
    Dim TitreClasseurAnnée As String
    Dim FinFichier As Boolean
 
    '****************************
    'Initialisation des variables
    '****************************
    TitreClasseurAnnée = "Mes données de "
    'Attribution de la feuille source à la variable ShS
    Set ShS = ThisWorkbook.Sheets("Travail")
 
    i = 2
    PremiereLigne = i
    DerniereLigne = i
    FinFichier = False
    'Récupération de l'éventuelle première année à considérer
    If IsNumeric(Cells(i, 13)) Then
        AnneeEnCours = Cells(i, 13)
    End If
 
    Do While Cells(i, 13) <> "" Or (i > 2 And Cells(i, 13) = "") And FinFichier = False
        'Si c'est la fin du fichier => permet d'enregistrer la dernière année puis stop la boucle
        If i > 2 And Cells(i, 13) = "" Then
            FinFichier = True
        End If
        'Si Nouvelle Année à considérer
        If Cells(i, 13) <> AnneeEnCours Then
            DerniereLigne = i - 1
            'Création d'un classeur avec 1 seule feuille
            Set ShD = Workbooks.Add(xlWBATWorksheet).Sheets(1)
 
            '******
            'Titres
            '******
            'Copie des titres
            Application.CutCopyMode = False
            ShS.Activate
            ShS.Range(Cells(1, 1), Cells(1, 13)).Copy
            'Collage des titres
            ShD.Activate
            ShD.Cells(1, 1).PasteSpecial
 
            '*******
            'Données
            '*******
            'Copie des données
            Application.CutCopyMode = False
            ShS.Activate
            ShS.Range(Cells(PremiereLigne, 1), Cells(DerniereLigne, 13)).Copy
            'Collage des données
                ShD.Activate
                ShD.Cells(2, 1).PasteSpecial
            'Nom de la feuille = Année considérée
            ShD.Name = AnneeEnCours
            'Fermeture et sauvegarde du classeur avec le titre du classeur
            ShD.Parent.Close True, TitreClasseurAnnée & AnneeEnCours
 
            'Nouvelle année à considérer
            AnneeEnCours = Cells(i, 13)
            'Nouveau début de sélection
            PremiereLigne = i
        End If
        i = i + 1
    Loop
    '*********************
    'Message d'information
    '*********************
    MsgBox "Traitement terminé avec succès", vbOKOnly + vbInformation, "Fin de traitement"
End Function

En passant je ne comprends pas ce que tu cherches à faire avec

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
 
'ajout dune ligne par annéé
 
Range("a1").Select
 
Do While ActiveCell.Value <> ""
AnneeEnCours = Year(ActiveCell.Offset(0, 2).Value)
If Year(ActiveCell.Offset(0, 2).Value) = Year(ActiveCell.Offset(1, 2).Value) Then
 
ActiveCell.Offset(1, 0).Select
 
Else
ActiveCell.Offset(1, 0).Select
Selection.EntireRow.Insert
ActiveCell.Offset(1, 0).Select
End If
Loop

sachant que si j'ai bien compris ton programme traite la feuille "Travail" du classeur contenant le code.
Donc tu tries la feuille qui ne contient pas de lignes vides.
Puis tu demandes les années à prendre en compte.
Pour chaque date:
Soit la ligne correspond à l'intervalle d'années considéré et tu ajoutes l'année en colonne 13
soit tu supprimes entièrement la ligne.

A présent, tu as donc un fichier niquel avec uniquement les lignes à considérer et la première ligne de titre.

A présent la fonction parcours ta colonne 13 donc les années et pour chaque année, un classeur est créé. Ce classeur contiendra uniquement les lignes correspondant à l'année + la ligne de titre.
Les classeurs seront bien sûr fermés au fur et à mesure.

Est-ce bien ce que tu veux ou ais-je mal compris?

J'aimerai juste créer une rupture par année, faire le document et le sauvegarder puis recommencer le traitement et donc faire ca par année.

Je n'ai pas compris l'histoire de numéro en revanche

je sélectionne : 522 444

Si ce n'est pas ça que tu veux, d'après les données que tu as mises sur le précédent post, que devrait-il se passer exactement?

[korni184]

Je te réexplique clairement :

Tu as mon fichier excel :

Il comporte une sheet Travail et plusieurs autres sheets avec le noms suivants :

-2002
-2003
-2004
-2005
-2006
-2007
-2008
-2009
-2010

Voilà, enfête j'ouvre un fichier texte dans la sheet travail qui comporte certaine données :

En voici un exemple :
QQ33 4422 5522 4444 1235 CCAQ 31.12.2003 12474,5 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1236 CCAQ 31.12.2004 13456,4 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1237 CCAQ 31.12.2005 12354,4 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1238 CCAQ 31.12.2006 15451,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1239 CCAQ 31.12.2007 44511,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1240 CCAQ 31.12.2008 45116,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1241 CCAQ 31.12.2009 15415,1 ART 0 0 0 0 0 0 NON
QQ33 4422 5522 4444 1242 CCAQ 31.12.2010 15451,2 ART 0 0 0 0 0 0 NON


QQ33 4422 5522 4444 XXXX est un ensemble de données, ils comportent tous 6 chiffres identiques (dans la réalité) c'est à dire 522 444 (numéro de racine).

C'est pour cela que j'ai créer une boucle, car quand j'ouvre ce fichier, il va y résider plusieurs RACINES.

Donc je supprime tous les lignes qui n'ont pas la même racine.

Ensuite le deuxième balayage intervient au moment de l'année : si je choisi la tranche 2002-2003 au moment de la message box, il me supprimera tous le reste des années (donc des lignes supplementaires).

Et dans un roisième temps je voudrais qu'il identifi la ligne par un Year comme j'ai fait (ajouter dans la boucle), et qu'il coupe et colle chaque ligne d'année dans des sheets différentes sur le même classeur excel.

Pour qu'à la fin la sheet travail soit vide, et que les sheet 2002 à ......... soient remplies par les données.

et pour terminer, je ne veux rien sauvegarder, rien fermer. Car je dois coller un code à la suite qui fera la suite du traitement.

Dit moi si tu comprends mieux ?

Enfin de compte je me suis peut être mal exprimer :

Ce que je voudrais faire tous simplement, c'est un tri :
Les lignes avec 2002, Cut dans la sheet 2002, etc...

c'est possible cela ?

[buzz73]

Ok j'ai mieux compris.

Voici la fonction modifiée elle copie et colle, c'est plus rapide que des couper-coller et plus souple si tu veux faire d'autres choses ensuite avec la feuille initiale.

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
 Public Function MaFonction()
    Dim i As Long
    Dim PremiereLigne As Long
    Dim DerniereLigne As Long
    Dim ShS As Worksheet 'Feuille source
    Dim ShD As Worksheet 'Feuille Destination
    Dim AnneeEnCours As Integer
    Dim FinFichier As Boolean
 
    '****************************
    'Initialisation des variables
    '****************************
    'Attribution de la feuille source à la variable ShS
    Set ShS = ThisWorkbook.Sheets("Travail")
 
    i = 1
    PremiereLigne = i
    DerniereLigne = i
    FinFichier = False
    'Récupération de l'éventuelle première année à considérer
    If ShS.Cells(i, 13) <> "" Then
        AnneeEnCours = ShS.Cells(i, 13)
    Else
        'Fichier vide
        Exit Function
    End If
 
    Do While FinFichier = False
        'Si c'est la fin du fichier => permet d'enregistrer la dernière année puis stop la boucle
        If ShS.Cells(i, 13) = "" Then
            FinFichier = True
        End If
        'Si Nouvelle Année à considérer
        If ShS.Cells(i, 13) <> AnneeEnCours Then
                DerniereLigne = i - 1
            'Création d'un classeur avec 1 seule feuille
            Set ShD = ThisWorkbook.Sheets(CStr(AnneeEnCours))
 
            '*******
            'Données
            '*******
            'Copie des données
            ShS.Activate
            ShS.Range(Cells(PremiereLigne, 1), Cells(DerniereLigne, 13)).Copy
            'Collage des données
                ShD.Activate
                ShD.Cells(1, 1).PasteSpecial
 
            'Nouvelle année à considérer
            AnneeEnCours = ShS.Cells(i, 13)
            'Nouveau début de sélection
            PremiereLigne = i
        End If
        i = i + 1
    Loop
    '*********************
    'Message d'information
    '*********************
    MsgBox "Traitement terminé avec succès", vbOKOnly + vbInformation, "Fin de traitement"
End Function

[korni184]

Bonjour,

Je viens d'essayer le code, est donc il fait la selection, mais il n'effectue pas le tri.

Comment faire ?

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
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
 
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
 
Call MaFonction
 
End Sub
 
 
  Public Function MaFonction()
    Dim i As Long
    Dim PremiereLigne As Long
    Dim DerniereLigne As Long
    Dim ShS As Worksheet 'Feuille source
    Dim ShD As Worksheet 'Feuille Destination
    Dim AnneeEnCours As Integer
    Dim FinFichier As Boolean
 
    '****************************
    'Initialisation des variables
    '****************************
    'Attribution de la feuille source à la variable ShS
    Set ShS = ThisWorkbook.Sheets("Travail")
 
    i = 1
    PremiereLigne = i
    DerniereLigne = i
    FinFichier = False
    'Récupération de l'éventuelle première année à considérer
    If ShS.Cells(i, 13) <> "" Then
        AnneeEnCours = ShS.Cells(i, 13)
    Else
        'Fichier vide
        Exit Function
    End If
 
    Do While FinFichier = False
        'Si c'est la fin du fichier => permet d'enregistrer la dernière année puis stop la boucle
        If ShS.Cells(i, 13) = "" Then
            FinFichier = True
        End If
        'Si Nouvelle Année à considérer
        If ShS.Cells(i, 13) <> AnneeEnCours Then
                DerniereLigne = i - 1
            'Création d'un classeur avec 1 seule feuille
            Set ShD = ThisWorkbook.Sheets(CStr(AnneeEnCours))
 
            '*******
            'Données
            '*******
            'Copie des données
            ShS.Activate
            ShS.Range(Cells(PremiereLigne, 1), Cells(DerniereLigne, 13)).Copy
            'Collage des données
                ShD.Activate
                ShD.Cells(1, 1).PasteSpecial
 
            'Nouvelle année à considérer
            AnneeEnCours = ShS.Cells(i, 13)
            'Nouveau début de sélection
            PremiereLigne = i
        End If
        i = i + 1
    Loop
    '*********************
    'Message d'information
    '*********************
    MsgBox "Traitement terminé avec succès", vbOKOnly + vbInformation, "Fin de traitement"
End Function

[buzz73]

Je viens d'essayer le code, est donc il fait la selection, mais il n'effectue pas le tri.

Je ne comprends pas ce que tu veux dire.

Ton code traite les lignes et ne laisse que les valides.
la fonction MaFontion parcours chacune des lignes restantes et copie-colle les lignes par année dans les feuilles comportant le nom de l'année considérée par la sélection.

De quel tri veux-tu parler?

[korni184]

Il fait un premier tri, car il y a une vingtaine de ligne. Il supprime d'abord les données dont je n'ai pas besoin et après il s'arrête. Et lorsque je vais voir dans les différentes sheets avec les années, elles sont vides.

[buzz73]

Je ne sais pas où tu en es mais ceci devrait faire l'affaire:

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
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
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
Sub Macro1()
 
Dim ShTravail As Worksheet
Dim cpt As Long
Dim i As Long
 
'Choix de la racine
Racine = InputBox("Indiquer la racine à traiter (sanstiret) ", "RACINE")
'Choix des bornes Années
DatesDebutFin = InputBox("Indiquer les années à considérer ", "ANNEES")
 
'Attribution des années aux variables
If DatesDebutFin = "" Then
    DDebut = 1900
    DFin = 2100
Else
    DDebut = Int(Left(DatesDebutFin, 4))
    DFin = Int(Right(DatesDebutFin, 4))
End If
 
 
'Feuille de travail
Set ShTravail = ThisWorkbook.Sheets("Travail")
 
'**********
'Traitement
'**********
 
'Activation de la feuille de travail
ShTravail.Activate
'Tri des données sur les colonnes A et C par tris ascendants
ShTravail.Columns("A:L").Sort _
    Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("C1"), Order2:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal
 
'*******************************
'Elimination des lignes inutiles
'*******************************
'Initialisation de la première ligne considérée
i = 1
'Sélection de la première cellule
ShTravail.Range("A1").Select
'Tant que la cellule sélectionnée n'est pas vide
Do While ShTravail.Cells(i, 1) <> ""
    'Repérage de la zone racine
    ZoneRacine = (Mid(ShTravail.Cells(i, 1).Value, 12, 3) & Mid(ShTravail.Cells(i, 1).Value, 16, 3))
    'Si zone racine reconnue
    If ZoneRacine = Racine Then
        'Repérage de l'année
        ZoneAnnee = Year(ShTravail.Cells(i, 3))
        'Si année est bonne
        If (ZoneAnnee >= DDebut And ZoneAnnee <= DFin) Then
            'Ajout de l'année en colonne 13
            ShTravail.Cells(i, 13) = Year(ShTravail.Cells(i, 3))
        Else
            'Suppression de la ligne
            ShTravail.Rows(i).Delete
            i = i - 1
        End If
    Else
        ShTravail.Rows(i).Delete
        i = i - 1
    End If
    'Ligne suivante
    i = i + 1
Loop
 
'*******************************************
'Sortie avec message si rien dans le fichier
'*******************************************
If i - 1 = 0 Then 'i-1 car à la fin de la boucle, on ajoute systématiquement 1 => à la fin, on est "1 ligne trop loin"
    MsgBox "Pas de racine.", vbOKOnly + vbCritical, "Arrêt du traitement"
    Exit Sub
End If
 
'***************************************************************************************************************
'Distribue les lignes restantes dans les différents onglets du classeur contenant la feuille passée en paramètre
'suivant les années
'***************************************************************************************************************
Call MaFonction(ShTravail)
 
End Sub
 
 
'***************************************************************************************************************
'Fonction qui copie-colle les lignes de la feuille passée en paramètre
'dans les différents onglets du classeur passé en paramètres (classeur contenant la feuille passée en paramètre
'=> on l'a directement avec "FeuillePasseeEnParametre.Parent")
'suivant les années
'***************************************************************************************************************
Public Function MaFonction(ByVal ShS As Worksheet)
    Dim i As Long
    Dim PremiereLigne As Long
    Dim DerniereLigne As Long
    'ShS => Feuille source
    Dim ShD As Worksheet 'Feuille Destination
    Dim AnneeEnCours As Integer
    Dim FinFichier As Boolean
 
    '****************************
    'Initialisation des variables
    '****************************
    i = 1
    PremiereLigne = i
    DerniereLigne = i
    FinFichier = False
    'Récupération de l'éventuelle première année à considérer
    If ShS.Cells(i, 13) <> "" Then
        AnneeEnCours = ShS.Cells(i, 13)
    Else
        'Fichier vide
        Exit Function
    End If
 
    Do While FinFichier = False
        'Si c'est la fin du fichier => permet d'enregistrer la dernière année puis stop la boucle
        If ShS.Cells(i, 13) = "" Then
            FinFichier = True
        End If
        'Si Nouvelle Année à considérer
        If ShS.Cells(i, 13) <> AnneeEnCours Then
                DerniereLigne = i - 1
            'Attribue à la variable ShD la feuille de destination pour coller les données
            'ShS.Parent => objet contenant ShS => comme ShS est une feuille, ShS.Parent est un classeur
            Set ShD = ShS.Parent.Sheets(CStr(AnneeEnCours)) 'Au lieu de "Set ShD = ThisWorkbook.Sheets(CStr(AnneeEnCours))"
 
            '*******
            'Données
            '*******
            'Copie des données
            ShS.Activate
            ShS.Range(Cells(PremiereLigne, 1), Cells(DerniereLigne, 13)).Copy
            'Collage des données
                ShD.Activate
                ShD.Cells(1, 1).PasteSpecial
 
            'Nouvelle année à considérer
            AnneeEnCours = ShS.Cells(i, 13)
            'Nouveau début de sélection
            PremiereLigne = i
        End If
        i = i + 1
    Loop
End Function

[korni184]

Merci beaucoup pour votre aide, le document fonctionne à merveille.

Vous pourriez peut etre m'aider pour une dernière question ?

Je peux créer un nouveau sujet si vous voulez

[buzz73]

En effet, si c'est un autre sujet, il est préférable de la traiter sur un nouveau fil.