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
| Sub transport()
Dim c As Integer
Dim DateEnCours As Date
Dim Quai As String
Application.ScreenUpdating = False 'la mise à jour de l'écran est désactivée
Cells.Select
On Error Resume Next 'gestion des erreurs qui permet de continuer le programme
'meme s'il y a une erreur : dans ce ca precis les les filtres peuvent etre tous affiches
ActiveSheet.ShowAllData ' afficher tous les filtres
On Error GoTo 0 ' interruption de la gestion des erreurs
DateEnCours = Cells(6, 1).Value ' cellule de la sixieme ligne, premiere colonne soit A6 Quai = Cells(1, 2).Value ' cellule de la premiere ligne, seconde colonne soit B1
c = Range("c" & Range("c65353").End(xlUp).Row).Row ' formule pour recuperer le N° de la dernière ligne de la colonne C
Range("A6:V" & c - 1).Select ' selection du tableau allant de la cellule B3 a la derniere cellule de la colonne V
Selection.Copy
'sélectionner / ouvrir le fichier "echanges 2008"
On Error GoTo GestionErreurFichier
Workbooks("echanges 2009.xls").Worksheets("donnees hermes").Activate
On Error GoTo 0
Cells.Select
On Error Resume Next 'gestion des erreurs qui permet de continuer le programme
'meme s'il y a une erreur : dans ce ca precis les les filtres peuvent etre tous affiches
ActiveSheet.ShowAllData ' afficher tous les filtres
On Error GoTo 0 ' interruption de la gestion des erreurs
Range("C2").Select
If Range("C3").Value <> "" Then Range("C2").End(xlDown).Select 'Si la cellule C3 n'est pas vide,
'on selectionne la derniere cellule non vide de la colonne D. Si C3 est libre, la derniere cellule non vide est C2.
ActiveCell.Offset(1, 0).Select 'On selectionne la cellule situee une ligne en dessous de la cellule active.
LigDeb = ActiveCell.Row 'ligne active
On Error Resume Next 'gestion des erreurs qui permet de continuer le programme
'meme s'il y a une erreur : dans ce ca precis les les filtres peuvent etre tous affiches
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' on copie le tableau
'selectionner a partir de la premiere ligne vide de la feuille "echange 2008
Application.CutCopyMode = False 'instrcution qui permet d'effacer la marque de selection autor de la plage copiee
On Error GoTo 0 ' interruption de la gestion des erreurs
Creation d'une boucle For to next
LigFin = Range("C2").End(xlDown).Row 'derniere ligne non vide de la colonne C
For Lig = LigDeb To LigFin ' derniere ligne non vide de la colonne C
Cells(Lig, 2).Value = DateEnCours
Cells(Lig, 1).Value = Quai
Next Lig
Application.ScreenUpdating = True 'la mise à jour de l'écran est activée
Columns("B:B").Select
Selection.NumberFormat = "mmmm-yyyy"
Columns("X:X").Select
Selection.NumberFormat = "#,##0"
' CE QUI SUIT N'A PAS D"IMPACT SUR MON ANOMALIE
' creation d'une boucle do..loop ; celle -ci commence a partir de la cellule x (ligne 3 colonne 2) et s'arrete a la premiere cellule vide rencontree dans la colonne 2
Lig = 3
Do
x = Cells(Lig, 2).Value
If x = "" Then Exit Do ' si la cellule est vide alors je quitte la boucle
Lig = Lig + 1 ' si la cellule est NON vide alors on aditionne a la ligne 3 la ligne de dessous
Loop
LigFin = Lig - 1 ' sortie de la boucle . Lig -2 =Numero de la derniere ligne non vide
LigDeb = 2
Cells(1, 1).Select
Range("K1").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(9,R[" & LigDeb & "]C:R[" & LigFin - 1 & "]C)"
Range("K1").Select
Selection.Copy
Range("K1:V1,X1").Select
Range("K1:V1, X1").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False 'instrcution qui permet d'effacer la marque de selection autor de la plage copiee
Exit Sub
GestionErreurFichier:
Workbooks.Open Filename:="C:\Documents and Settings\GHEMMAZI Hayette\Desktop\echanges 2009.xls"
Resume
ActiveWorkbook.Save
End Sub |
creation d'une boucle
Répondre avec citation
Partager