Discussion :

[Enfermania]

Bonjour à tous!

Voilà j'ai un petit problème :
Je dois créer une Macro qui simplifie le nombre de ligne et le nombre de colonne d'un fichier Excel (Source), dois prendre un 2ème fichier Excel (Mobility1), les lignes que je veux, pour l'intégrer dans mon fichier Source.
Bon jusque là, j'y arrive a peu près... J'utilise au début de ma Macro :

Code :

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

1
2
         Sheets("Source").Select
            Sheets("Source").Copy

Et pof! Il me créer un Classeur1.

Plus tard dans ma Macro (lorsque j'ai supprimé les lignes qui ne m'intéressent pas et fait tout ce que j'avais à faire), je veux copier les lignes de mon fichier Mobility1 et les coller à la fin des lignes de mon fichier Source. (Suis-je clair?!) J'ai donc

Code :

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

1
2
3
      Windows("Mobility1").Activate
        Sheets("UO_Mobility").Copy                    et POF j'ai mon Classeur2 créé!
        Windows("Classeur2").Activate

Sauf que pour passer de mon fichier Mobility (copie) à mon fichier Source (colle, à la fin des lignes), j'ai "Windows("Mobility1").Activate" qui me lance une erreur :
Erreur d'éxécution 9 : L'indice n'appartient pas à la sélection !

Que faire? Y a t-il d'autres moyens pour passer d'un classeur à un autre? Workbooks à préférer?

Comprenez que je copie mes Sheets pour ne pas modifier (et donc supprimer) mes fichiers d'origine.

Je tourne sous Excel 2010, mon boss aussi, sur mon pc tout fonctionne bien, sur le sien, bug à cette ligne!

[vinc_bilb]

Bonjour,

Il vaut mieux passer par le workbook que par le window ....

Exemple de code à adapter

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
ThisWorkbook.Worksheets(SrcWsname).Copy  'SrcWsname est le nom de la feuille à copier
 
    Set Ext_Wbkk = ActiveWorkbook   'Workbook destination
 
 
        ' Si besoin, efface les sheets autres du workbook destination, normalement, ne sert à rien
 
If Ext_Wbkk.Worksheets.Count > 1
   For Each WS In Ext_Wbkk.Worksheets
        If (WS.Name) <> SrcWsname Then Worksheets(WS.Name).Delete
    Next WS
End If

[Enfermania]

Bonjour vinc_bilb et merci pour ta réponse rapide!

Par contre, OULA, je ne comprends rien a ce que tu as écrit, je suis débutant en VBA!

Je ne peux pas simplement faire :

Code :

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

Workbooks("Mobility1").Activate

Non ?

Merci

J'aurais besoin d'un peu d'aide car je dois rendre mon projet avant ce soir!

J'ai utilisé :

Code :

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

1
2
 
Workbooks.("Mobility1").Select

Mais cela plante sur mon ordi!

NEED HELP PLEASE!!!

Merci d'avance!

[vinc_bilb]

Bonjour,

Vous pourriez envoyer votre code complet, voire le fichier?

[Enfermania]

Bonjour vinc_bilb,

Malheureusement je ne peux pas envoyer le fichier car il présente les Nom et Prénom de salariés dans l'entreprise où je suis actuellement en stage!

Mais je peux t'envoyer une partie de mon code :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sheets("Source").Select
Sheets("Source").Copy        'Me copie mon Classeur TUSFR Feuille Source en Classeur1
[.....]
    If NbLignesFin > 1 Then
    MsgBox ("Vous êtes passé de " & NbLignesOrigine & " à " & NbLignesFin & " lignes dans ce document")
    Else
    MsgBox ("Vous êtes passé de " & NbLignesOrigine & " à " & NbLignesFin & " ligne dans ce document")
    End If
 
    Windows("Mobility1").Activate         'Est censé passer de mon Classeur1 (sur lequel je supprime les lignes) à mon Classeur Mobility1 (que je veux copier)
        Sheets("UO_Mobility").Copy        'Me copie mon Classeur Mobility1 Feuille UO_Mobility en Classeur2
    Windows("Classeur2").Activate        'Est censé passer de mon Mobility1 à mon Classeur2 (Classeur2 = celui que je veux modifier et copier les lignes dans mon Classeur1)

J'ai toujours l'erreur 9 : L'indice n'appartient pas à la sélection à [Windows("Mobility1").Activate]

Je n'ai pas compris ta réponse d'hier, j'ai vu que tu utilise un .Delete , mais je ne veux pas supprimer mes feuilles, juste les copier-coller et modifier la feuille collée.

Merci de te soucier de mon problème.

Merci d'avance pour ta réponse.

[vinc_bilb]

Bonjour,

Vous pourriez fournir un fichier expurgé, juste avec quelques éléments fictifs.

Dans quel workbook est votre code? Mobility1?

Bon, sur la base de ce que je peux faire avec quelques éléments (et nons testé):

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
 
Sub Test_Copy
 
Dim WbkSrc As Workbook, WbkDest As Workbook    'Source et Destination
Dim WshDest As Worksheet                                  'Destination
 
Set WbkSrc = ThisWorkbook                                 'ou Workbooks("TUSFR")
 
WbkSrc.Worksheets("Source").Copy                        'Copie mon Classeur TUSFR Feuille Source dans un nouveau classeur
 
Set WbkDest  = ActiveWorkbook                           'Workbook destination
Set WshDest = ActiveWorksheet
 
Debug.Print  WbkDest.Name, WshDest.Name
 
'Si l'on veut copier une autre worksheet du classeur source vers le dest, après la feuille "source"
WbkSrc.Worksheets("UO_Mobility").Copy After:=WshDest 
 
End Sub

[Enfermania]

Re-Bonjour,

Sur ta demande je te fourni mon code complet, ce que je veux faire :
- Copier mon fichier TUSFR en un nouveau classeur (Classeur1) et le renommer en TUSFRFabien
- Supprimer les lignes de mon fichier TUSFRFabien (fait au début du code par ma boucle For et toutes ses conditions)
- Copier mon fichier Mobility1 en un nouveau classeur (Classeur2) et le renommer en Mobility2
- Supprimer les lignes de mon fichier Mobility2
- Copier les lignes restantes de mon fichier Mobility2 à la fin des lignes de mon nouveau TUSFRFabien (Classeur1)


Il faut bien comprendre que pour exécuter ma Macro j'ouvre mon fichier TUSFR, mon fichier Mobility1 et mon fichier MacroFabien1.0 sur lequel est ma Macro!

Je te fourni mon 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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
 
Sub EssaiDéfinitif()
'
' EssaiDéfinitif Macro
' Copie TOUTES les cellules de la feuille 1 nommée "Source" et les collent dans une nouveau classeur nommée "Classeur X". Puis exécute la macro 9.0
'
    Dim NbLignesOrigine
    NbLignesOrigine = ActiveSheet.UsedRange.Rows.Count 'NbLignesOrigine non vides max
 
 
If NbLignesOrigine > 2500 And Range("A1") = "Société" Then
 
            Sheets("Source").Select
            Sheets("Source").Copy
 
 
        For i = NbLignesOrigine To 2 Step -1
            If Range("P" & i) <> "Imprimante" And Range("P" & i) <> "Unité centrale" Then 'SI le contenu de la colonne P est DIFFERENT de Imprimante ou Unité centrale
                Range(i & ":" & i).Select                                                 'ALORS On sélectionne le contenu et on le supprime
                Selection.Delete
            End If
            If Range("AC" & i) <> "En service" Then          'SI le contenu de la colonne AC est DIFFERENT de En service
                Range(i & ":" & i).Select                   'ALORS On sélectionne le contenu et on le supprime
                Selection.Delete
            End If
            If Range("AP" & i) <> "Infogérant" Then         'SI le contenu de la colonne AP est DIFFERENT de Infogérant
                Range(i & ":" & i).Select                   'ALORS On sélectionne le contenu et on le supprime
                Selection.Delete
            End If
            If Range("P" & i) = "Unité centrale" And (Range("Q" & i) <> "Desktop" And Range("Q" & i) <> "Laptop" And Range("Q" & i) <> "Terminal" And Range("Q" & i) <> "Workstation") Then 'SI lorsqu'on filtre Unité centrale en colonne P, on garde Desktop ET Laptop ET Terminal ET Workstation en colonne Q!
                Range(i & ":" & i).Select                                                                                                                                                   'ALORS On sélectionne le contenu et on le supprime
                Selection.Delete
            End If
            If Range("P" & i) = "Imprimante" And (Range("S" & i) <> "Imprimante départementale" And Range("S" & i) <> "Service xerox") Then 'SI le contenu de la colonne P est Imprimante, ET en colone S on garde Imprimante départementale ET Service xerox
                Range(i & ":" & i).Select                                                                                                   'ALORS On sélectionne le contenu et on le supprime
                Selection.Delete
            End If
        Next i
 
        Columns("A:T").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 'Insert des colonnes de A à T
 
    Dim NbLignesFin, cpt1
    NbLignesFin = ActiveSheet.UsedRange.Rows.Count 'NbLignesFin non vides max
 
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Origine"
    cpt1 = 2
        While cpt1 <= NbLignesFin 'TANT QUE la variable cpt1 est <= mon NbLignesFin, la boucle est répétée
            Cells(cpt1, 1) = "PAM" 'Numérotation inscrit PAM dans la colonne 1 ligne cpt1
            cpt1 = cpt1 + 1 'Le numéro est augmenté de 1 à chaque boucle
        Wend
 
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Pays"
    cpt1 = 2
        While cpt1 <= NbLignesFin
            Cells(cpt1, 2) = "France"
            cpt1 = cpt1 + 1
        Wend
 
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Division"
    cpt1 = 2
        While cpt1 <= NbLignesFin
            Cells(cpt1, 3) = "DMS"
            cpt1 = cpt1 + 1
        Wend
 
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Entité"
    cpt1 = 2
        While cpt1 <= NbLignesFin
            Cells(cpt1, 4) = "TUS"
            cpt1 = cpt1 + 1
        Wend
 
    Range("Z1").Select                              'selectionne la colonne SITE
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("E1").Select                              'se met en position E1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Colle la sélection en "copie de valeurs"
 
    Range("X1").Select                              'selectionne la colonne SERVICE
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("F1").Select                              'se met en position F1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "SBL"
    'Colle la sélection en "copie de valeurs"
 
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "Domaine"
    cpt1 = 2
        While cpt1 <= NbLignesFin
            Cells(cpt1, 7) = "Service à l'Utilisateur"
            cpt1 = cpt1 + 1
        Wend
 
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Sous-Domaine"
    cpt1 = 2
        While cpt1 <= NbLignesFin
            Cells(cpt1, 8) = "Services Bureautiques Standards"
            cpt1 = cpt1 + 1
        Wend
 
    Range("AK1").Select                             'selectionne la colonne TypeCatégorieEquipement
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("I1").Select                              'se met en position I1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "UO"
    'Colle la sélection en "copie de valeurs"
 
 
 
    Range(Columns("AD"), Columns("AF")).Select      'selectionne la colonne TGI + Nom + Prénom
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("K1").Select                              'se met en position K1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("AN1").Select                             'selectionne la colonne CAB Pere
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("N1").Select                              'se met en position N1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Style = "Comma"
    Selection.NumberFormat = 0
 
    Range("AT1").Select                             'selectionne la colonne N° Série
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("O1").Select                              'se met en position O1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("AH1").Select                             'selectionne la colonne Constructeur
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("P1").Select                              'se met en position P1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
 
    Range("AI1").Select                             'selectionne la colonne Modèle
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("Q1").Select                              'se met en position Q1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Quantité"                                     'Marque quantité dans la première cellule
    cpt1 = 2
        While cpt1 <= NbLignesFin
            Cells(cpt1, 18) = "1"
            cpt1 = cpt1 + 1
        Wend
 
    Dim NbLignes1
    NbLignes1 = ActiveSheet.UsedRange.Rows.Count
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "RemarqueConfig"                                     'Marque RemarqueConfig dans la première cellule
        For i = NbLignes1 To 2 Step -1
            Range("S" & i) = Range("AA" & i) & Range("AB" & i) & Range("AC" & i)      'CONCATENE EN S LES COLONNES Bâtiment(AA), Etage(AB) et Bureau(AC)
        Next i
 
    Range("AX1").Select                             'selectionne la colonne Réseau
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("T1").Select                              'se met en position T1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
    Dim NbLignes2
    NbLignes2 = ActiveSheet.UsedRange.Rows.Count
    For i = NbLignes2 To 2 Step -1
        If Range("AK" & i) = "Laptop" And Range("AL" & i) = "Standard" Then
            Range("I" & i).Select
            ActiveCell.FormulaR1C1 = "Laptop UD"                                'Remplace "AK":Laptop ("AL":standard) par "I" = Laptop UD
        End If
        If Range("AK" & i) = "Laptop" And Range("AL" & i) = "Ultra-Léger" Then
            Range("I" & i).Select
            ActiveCell.FormulaR1C1 = "Laptop Light UD"                          'Remplace "AK":Laptop si ("AL":Ultra-Léger) par "I" = Laptop Light UD
        End If
        If Range("AK" & i) = "Workstation" And Range("AL" & i) = "Laptop" Then
            Range("I" & i).Select
            ActiveCell.FormulaR1C1 = "Workstation UEE"                          'Remplace "AK":Workstation si ("AL":Laptop) par "I" = Workstation UEE
        End If
        If Range("AK" & i) = "Workstation" And Range("AL" & i) = "Standard" Then
            Range("I" & i).Select
            ActiveCell.FormulaR1C1 = "Workstation UEE"                          'Remplace "AK":Laptop si ("AL":Ultra-Léger) par "I" = Laptop Light UD
        End If
        If Range("AK" & i) = "Workstation" And Range("AL" & i) = "Haut de gamme" Then
            Range("I" & i).Select
            ActiveCell.FormulaR1C1 = "Workstation UEE HG"                       'Remplace "AK":Laptop si ("AL":Ultra-Léger) par "I" = Laptop Light UD
        End If
        If Range("AM" & i) = "Imprimante départementale" Then
            Range("I" & i).Select
            ActiveCell.FormulaR1C1 = "Imprimante départementale"                'Mets imprimante départementale dans la celulle "I : i" si "AM": Imprimante départementale
        End If
    Next i
 
         Cells.Replace What:="Desktop", Replacement:="Desktop UD", LookAt:=xlPart _
        , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False 'remplace Desktop par Desktop UD
 
        Cells.Replace What:="Terminal", Replacement:="Terminal X", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False 'remplace terminal par Terminal X
 
        Columns("U:BZ").Select
        Selection.Delete
 
    Columns("A:T").EntireColumn.AutoFit
    Columns("A:T").Select
    Selection.AutoFilter
 
    If NbLignesFin > 1 Then
    MsgBox ("Vous êtes passé de " & NbLignesOrigine & " à " & NbLignesFin & " lignes dans ce document")
    Else
    MsgBox ("Vous êtes passé de " & NbLignesOrigine & " à " & NbLignesFin & " ligne dans ce document")
    End If
 
   Rows("1:1").Select      'sélectionne la première ligne
        With ActiveWindow
            .SplitColumn = 0
            .SplitRow = 1
        End With
    ActiveWindow.FreezePanes = True     ' fige la première ligne
 
    Windows("Mobility1").Activate
        Sheets("UO_Mobility").Copy
    Windows("Classeur2").Activate
 
    NbLignes3 = ActiveSheet.UsedRange.Rows.Count
        For i = NbLignes3 To 5 Step -1
            If Range("V" & i) <> "Idem" And Range("V" & i) <> "Nouvelle entrée" Then             'SI la colonne Diff. 05/2015 est DIFFERENT de "Idem" OU "Nouvelle entrée"
                    Range(i & ":" & i).Select                                                   'ALORS On sélectionne le contenu et on le supprime
                    Selection.Delete
            End If
        Next i
 
    NbLignes4 = ActiveSheet.UsedRange.Rows.Count
    Range("A5", "C5").Select                            'Sélectionne TGI + Nom + Prénom
    Range(Selection, Selection.End(xlDown)).Select      'jusqu'en bas
    Selection.Copy                                      'le copie
    Windows("Classeur1").Activate                       'passe au Classeur1
    Range("K" & NbLignesFin + 1).Select                 'sélectionne la lignefin en colonne K (TGI + Nom + Prénom)
    ActiveSheet.Paste                                   'colle sur le Classeur1 en colonne K
 
    Windows("Classeur2").Activate                       'sélectionne le Classeur2 (Mobility1 copie)
    Range("E5").Select                                  'sélectionne la 1ere cellule Site
    Range(Selection, Selection.End(xlDown)).Select      'jusqu'en bas
    Selection.Copy                                      'le copie
    Windows("Classeur1").Activate                       'passe au Classeur1
    Range("E" & NbLignesFin + 1).Select                 'sélectionne la lignefin en colonne E (site)
    ActiveSheet.Paste                                   'colle sur le Classeur1 en colonne E
 
    Windows("Classeur2").Activate                       'sélectionne le Classeur2 (Mobility1 copie)
    Range("F5").Select                                  'sélectionne la 1ere cellule Service
    Range(Selection, Selection.End(xlDown)).Select      'jusqu'en bas
    Selection.Copy                                      'le copie
    Windows("Classeur1").Activate                       'sélectionne le Classeur1
    Range("F" & NbLignesFin + 1).Select                 'sélectionne la lignefin en colonne F (Service)
    ActiveSheet.Paste                                   'colle sur le Classeur1 en colonne F
 
    Windows("Classeur2").Activate                       'sélectionne le Classeur2 (Mobility1 copie)
    Range("H5").Select                                  'sélectionne la 1ere cellule CAB
    Range(Selection, Selection.End(xlDown)).Select      'jusqu'en bas
    Selection.Copy                                      'le copie
    Windows("Classeur1").Activate                       'sélectionne le Classeur1
    Range("N" & NbLignesFin + 1).Select                 'sélectionne la lignefin en colonne N (CAB)
    ActiveSheet.Paste                                   'colle sur le Classeur1 en colonne N
    Selection.Style = "Comma"
    Selection.NumberFormat = 0
 
    Windows("Classeur2").Activate                       'sélectionne le Classeur2 (Mobiltiy1 copie)
    Range("T5").Select                                  'sélectionne la 1ere cellule Modèle
    Range(Selection, Selection.End(xlDown)).Select      'jusqu'en bas
    Selection.Copy                                      'le copie
    Windows("Classeur1").Activate                       'sélectionne le Classeur1
    Range("Q" & NbLignesFin + 1).Select                 'sélectionne la lignefin en colonne Q (Modèle)
    ActiveSheet.Paste                                   'colle sur le Classeur1 en colonne Q
 
    Range("F1").Select                              'selectionne la nouvelle colonne SERVICE
    Range(Selection, Selection.End(xlDown)).Select  'jusqu'en bas
    Selection.Copy                                  'copie la selection
    Range("J1").Select                              'se met en position J1
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Département"
    'Colle la sélection en "copie de valeurs"
 
    Dim NbLignesFinfin
    NbLignesFinfin = ActiveSheet.UsedRange.Rows.Count 'NbLignesFinfin non vides max
 
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin 'TANT QUE la variable cpt1 est <= mon NbLignesFin, la boucle est répétée
            Cells(cpt1, 1) = "PAM" 'Numérotation inscrit PAM dans la colonne A (Origine) ligne cpt1
            cpt1 = cpt1 + 1 'Le numéro est augmenté de 1 à chaque boucle
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 2) = "France"               'Marque France en colonne B (Pays)
            cpt1 = cpt1 + 1
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 3) = "DMS"                  'Marque DMS en colonne C (Division)
            cpt1 = cpt1 + 1
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 4) = "TUS"                  'Marque TUS en colonne D (Entité)
            cpt1 = cpt1 + 1
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 7) = "Service à l'Utilisateur"  'Marque Service à l'Utilisateur en colonne G (Domaine)
            cpt1 = cpt1 + 1
        Wend
 
     cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 8) = "Services Bureautiques Standards"  'Marque Services Bureautiques Standards en colonne H (Sous-Domaine)
            cpt1 = cpt1 + 1
        Wend
 
     cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 9) = "Option Mobility"      'Marque Option Mobility en colonne I (UO)
            cpt1 = cpt1 + 1
        Wend
 
    Range("R" & NbLignesFin + 1).Select
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 18) = "1"                   'Marque 1 en colonne R (Quantité)
            cpt1 = cpt1 + 1
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 15) = "NEANT"               'Marque NEANT en colonne O (N° Série)
            cpt1 = cpt1 + 1
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 16) = "OBERTHUR"            'Marque OBERTHUR en colonne P (constructeur)
            cpt1 = cpt1 + 1
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 19) = "NEANT"               'Marque NEANT en colonne S (concaténation)
            cpt1 = cpt1 + 1
        Wend
 
    cpt1 = NbLignesFin + 1
        While cpt1 <= NbLignesFinfin
            Cells(cpt1, 20) = "Standard"            'Marque Standard en colonne T
            cpt1 = cpt1 + 1
        Wend
 
                MsgBox ("Vous êtes passé de " & NbLignesFin & " à " & NbLignesFinfin & " lignes en plus!")
 
        Range("A1").Select
        Range("A1").Select
 
 
 
 
Else
MsgBox ("Votre document ne comporte pas assez de ligne OU" & vbLf & "la cellule A1 n'est pas 'Société' ")
End If
 
End Sub

Voilà!

Sur mon pc tout fonctionne, sur le pc de mon boss, erreur 9 à la ligne 242 : Windows("Mobility1").Activate, l'indice n'appartient pas à la sélection.

J'ai essayé d'ouvrir les 3 fichiers à partir d'Excel, et les 3 fichiers par l'explorateur windows, rien n'y fait!

NEED HELP PLEASE!

Merci d'avance à toute réponse!

Bonne journée

[Enfermania]

Re-Bonjour,

J'ai modifié mon "Windows("Mobility1").Activate" en "Windows("Mobility1.xlsx").Activate!

Et apparemment ça marche sur du Excel 2003!

Donc ça devrait fonctionner sur du Excel 2010 pas vrai?

J'ai donner ça à mon boss, j'attends sa réponse, et la votre bien sûr....

Bonne journée à tous!