Copier des données

**pimouslm** · 25/09/2017, 21h39

Bonsoir,

Dans le cadre de mon travail, j'ai créé un fichier copiant différentes données par l'intermédiaire de macros dans divers fichiers excel. La première partie du code, en noir, fonctionne parfaitement. Quand je réalise la même chose pour un autre fichier, la deuxième partie, en rouge, ne fonctionne pas et un bug se produit. Novice, j'ai besoin de votre aide.

Merci

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
Private Sub Workbook_Open()
 
 
'ouverture UCE
 
NomFichier = ActiveWorkbook.Name
datefic = Right(NomFichier, Len(NomFichier) - 16)
datefic = Left(datefic, Len(datefic) - 5)
Set TDB = ActiveWorkbook
Set UCE = Workbooks.Open("\\bra\dir_d\SAT-Unités B\Recueil UCE\Watt\" + datefic + "\Recueil CE Mensuel *.xlsx")
Set ACC = Workbooks.Open("S:\DSET – Sécurité exploitation\Sinistralité 2017\Watt\SUIVI ACCIDENT - WATT - 2017.xlsx""

'copie avances
  
UCE.Sheets(9).Select
    Range("B8:T563").Select
    Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(4).Select
    Range("C8").Select
    ActiveSheet.Paste
 
'retraitement somme sans lia
 
 
i = 8
Do While Cells(i, 20) <> ""
Cells(i, 20).FormulaR1C1 = "=SUM(RC[-15]:RC[-6])+SUM(RC[-3]:RC[-1])"
i = i + 1
Loop
 
 
'tri total avances sans lia
 
 
Cells(i - 1, 3).MergeCells = False
    Range("t7:t" & i - 1).Select
    ActiveWorkbook.Worksheets("AVANCES ").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AVANCES ").Sort.SortFields.Add Key:= _
        Range("t7"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("AVANCES ").Sort
        .SetRange Range("C8:u" & i - 1)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
'copie avances/retard lignes

UCE.Activate
UCE.Sheets(1).Select
    Range("B6:k18").Select
   Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(5).Select
    Range("B6").Select
    ActiveSheet.Paste
 
'copie avance 

 
UCE.Activate
UCE.Sheets(11).Select
    Range("B10:I563").Select
    Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
    Range("B10").Select
    ActiveSheet.Paste
   
' tribattement Macro

 
    Range("B403:C403").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort.SortFields.Add Key:= _
        Range("D9:D428"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'fermeture CE
 
NomUCE = UCE.Name
Application.CutCopyMode = False
Workbooks(NomUCE).Close SaveChanges:=False
Application.CutCopyMode = True
 
'copie suivi accidentologie
'ouverture ACC


ACC.Activate
ACC.Sheets("data").Select
     Range("B4:N21").Select
    Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
    Range("B6").Select
    ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

ACC.Activate
ACC.Sheets("data").Select
     Range("Q4:S21").Select
    Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
    Range("B135").Select
    ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False      
    
ACC.Activate
ACC.Sheets("data").Select
     Range("U4:U21").Select
    Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
    Range("B131").Select
    ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True    
    
NomACC = ACC.Name
Application.CutCopyMode = False
Workbooks(NomUCE).Close SaveChanges:=False
Application.CutCopyMode = True   
 
 
' ouverture de TBD

ActiveWorkbook.Worksheets("TDB").Activate
 
 
End Sub

**Menhir** · 26/09/2017, 08h59

Envoyé par pimouslm

la deuxième partie, ne fonctionne pas et un bug se produit.

"ne fonctionne pas", c'est un peu court comme description de problème.
Quel type de bug ? S'il y a un message d'erreur, quel est ce message ? Quel ligne est désignée par le débugage ?

**unparia** · 26/09/2017, 11h32

Bonjour
Prière de montrer ton code réel et entre balises code.

Si le code montré ici est un copié/collé fidèle de celui que tu as écrit, cette ligne de code :

Code :

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

Set ACC = Workbooks.Open("S:\DSET – Sécurité exploitation\Sinistralité 2017\Watt\SUIVI ACCIDENT - WATT - 2017.xlsx""

ne saurait déjà, elle-même et bien avant ce que tu dis, avoir été acceptée par l'éditeur VBA !

Et elle aurait provoqué une erreur d'exécution, sauf si précédée d'une instruction du type On Error Resume Next ou On Error goto ... (et je n'en vois pas dans ton code)

Et si tu en as mis une --->> ACC est Nothing lorsque tu l'utilises.

**Pierre Fauconnier** · 26/09/2017, 12h09

Salut.

Il faut préciser ce qui ne fonctionne pas, quelle ligne est en erreur, ...

On peut supposer que acc.activate pose problème et donc que acc ne pointe pas vers un classeur et est donc nothing.

Au delà de cette supposition, quelques considérations:

abandonne les select pour travailler avec des objets. Ton code sera plus clair, plus lisible et plus maintenable;
extrais ton code de copie pour en faire une fonction à laquelle passer les paramètres;
sors ton code de la proc _open et fais-y appel au sein de _open.

Mets tes balises de code dans ton message...

Nom : Balises.gif
Affichages : 119
Taille : 19,9 Ko

**pimouslm** · 26/09/2017, 12h23

Bonjour,

Merci pour vos réponses.
Voici le code complet.

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
 
Private Sub Workbook_Open()
 
 
'ouverture UCE
 
NomFichier = ActiveWorkbook.Name
datefic = Right(NomFichier, Len(NomFichier) - 16)
datefic = Left(datefic, Len(datefic) - 5)
Set TDB = ActiveWorkbook
Set UCE = Workbooks.Open("\\braque\dir_dbus\SAETD-Unités\Recueil UCE\Watt\" + datefic + "\Recueil UCE Mensuel *.xlsx")
Set ACC = Workbooks.Open("S:\DSET – Sécurité exploitation\Sinistralité 2017\Watt\SUIVI ACCIDENT - WATTrelos - 2017.xlsx")
 
 
'copie avances
 
 
UCE.Sheets(9).Select
    Range("B8:T563").Select
    Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(4).Select
    Range("C8").Select
    ActiveSheet.Paste
 
'retraitement somme sans lianes
 
 
i = 8
Do While Cells(i, 20) <> ""
Cells(i, 20).FormulaR1C1 = "=SUM(RC[-15]:RC[-6])+SUM(RC[-3]:RC[-1])"
i = i + 1
Loop
 
 
'tri total avances sans lianes
 
 
Cells(i - 1, 3).MergeCells = False
    Range("t7:t" & i - 1).Select
    ActiveWorkbook.Worksheets("AVANCES").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("AVANCES").Sort.SortFields.Add Key:= _
        Range("t7"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("AVANCES").Sort
        .SetRange Range("C8:u" & i - 1)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'copie avances/retard lignes
'
 
UCE.Activate
UCE.Sheets(1).Select
    Range("B6:k18").Select
   Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(5).Select
    Range("B6").Select
    ActiveSheet.Paste
 
'copie avance conducteur
'
 
UCE.Activate
UCE.Sheets(11).Select
    Range("B10:I563").Select
    Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
    Range("B10").Select
    ActiveSheet.Paste
 
' tribattement Macro
'
 
    Range("B403:C403").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort.SortFields.Add Key:= _
        Range("D9:D428"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("BATTEMENT").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
 
'copie suivi accidentologie
'
ACC.Activate
ACC.Sheets("data").Select
Range("B4:N21").Select
Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
Range("B6").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
ACC.Activate
ACC.Sheets("data").Select
Range("Q4:S21").Select
Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
Range("B135").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
ACC.Activate
ACC.Sheets("data").Select
Range("U4:U21").Select
Selection.Copy
Workbooks(NomFichier).Activate
 
ActiveWorkbook.Sheets(6).Select
Range("B131").Select
ActiveSheet.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
 
NomACC = acc.Name
Application.CutCopyMode = False
Workbooks(NomUCE).Close SaveChanges:=False
Application.CutCopyMode = True
 
 
 
'fermeture UCE
 
NomUCE = UCE.Name
Application.CutCopyMode = False
Workbooks(NomUCE).Close SaveChanges:=False
Application.CutCopyMode = True
 
 
' ouverture de TBD
ActiveWorkbook.Worksheets("TDB").Activate
 
 
End Sub

Comme je l'ai déjà mentionné je suis un novice en VBA (quelque semaines!).

Le but est de copier des données de différentes sources et les regroupé dans un seul classeur dans différentes feuilles..
quand je supprime la partie en rouge du code tout fonctionne normalement parcontre quand je rajoute le la partie en rouge " Erreur de compilation: fonction ou variable attendue."

Merci pour votre aide.

**NVCfrm** · 26/09/2017, 12h55

Saluts;
Bonjour Pimouslm, si tu as du temps à perdre, prière de ne pas en faire perdre aux autres, en continuant de présenter un code altéré qui ne reflète pas ce que tu demandes.

En dehors de beaucoup d'autres choses, dans le drenier code posté, on voit à la ligne 146 ceci : Workbooks(NomUCE).Close ....
Puis un peu plus bas, ligne 153 un appel à un objet qui n'existe plus.

Poste ton code tel qu'il est (ne crains rien de bonnes volontés t'aideront à l'améliorer); en indiquant éventuellement la ligne problématique avec le message d'erreur.

**Menhir** · 26/09/2017, 13h36

Envoyé par unparia

Et elle aurait provoqué une erreur d'exécution

Avec une parenthèse non fermée, c'est même le VBE qui l'aurait rejetée (en rouge) qui aurait refusé l'exécution.

Envoyé par pimouslm

quand je supprime la partie en rouge du code ...

Quelle partie en rouge ?
Par défaut, dans l'éditeur de ce forum, quand un code est mis entre balises CODE, tout ce qui est entre doubles cotes se met en rouge.
Donne un numéro de ligne, c'est plus simple.

**pimouslm** · 26/09/2017, 14h23

Bonjour,

je m'excuse si je me suis mal exprimée. vous trouverez ci-joint le fichier complet on espérons que ca vous aidera.

Erreur de la ligne 111 à 147.

merci

**NVCfrm** · 26/09/2017, 16h01

Désolé, les fichiers joints ne sont pas appréciés tant qu'on ne l'aura pas demandé.
Je ne suis pas le seul à croire que nous n'en sommes pas encore à réclamer un fichier.
Copie juste les codes ici avec suffisamment d'indications, même s'ils sont dans différents modules.

Copier des données

Macros et VBA Excel

Discussions similaires

Partager

Partager