Bonjour à tous,

j'ai un problème dans ma programmation VBA, je dois faire une sélection multiple entre plusieurs feuilles, copier puis coller dans un autre classeur. Malheureusement j'ai le message suivant :
"impossible d'exécuter cette commande sur des sélection multiple". j'ai essayé deux solutions :

1)
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
 Sheets("Fiche d'activité").Select
 
Dim r1, r2, myMultipleRange As Range
    Set r1 = Sheets("Fiche d'activité").Range("A10:G71")
    Set r2 = Sheets("Fiche d'activité").Range("W10:AC71")
    Set r3 = Sheets("Fiche d'activité").Range("AT10:AZ70")
 
Sheets("Fiche d'activité Médicale").Visible = True
Sheets("Fiche d'activité Médicale").Select
Set r4 = Sheets("Fiche d'activité").Range("A10:G39")
Set r5 = Sheets("Fiche d'activité").Range("W10:AC39")
Set r6 = Sheets("Fiche d'activité").Range("AT10:AZ39")
 
 
 
    Set myMultipleRange = Union(r1, r2, r3, r4, r5, r6)
    myMultipleRange.Font.Bold = True
myMultipleRange = Union(r1, r2, r3, r4, r5, r6).Copy
 
 
 
 Windows("Base de données Reporting.xlsm").Activate
 Sheets("Base de Travail").Select
 
Worksheets("Base de Travail").Range("A65536").End(xlUp).Offset(1, 0).Select
 
ActiveSheet.Paste
2)
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
Sheets("Fiche d'activité").Select
 
Dim r1, r2, myMultipleRange As Range
    Set r1 = Sheets("Fiche d'activité").Range("A10:G71")
    Set r2 = Sheets("Fiche d'activité").Range("W10:AC71")
    Set r3 = Sheets("Fiche d'activité").Range("AT10:AZ70")
 
Sheets("Fiche d'activité Médicale").Visible = True
Sheets("Fiche d'activité Médicale").Select
Set r4 = Sheets("Fiche d'activité").Range("A10:G39")
Set r5 = Sheets("Fiche d'activité").Range("W10:AC39")
Set r6 = Sheets("Fiche d'activité").Range("AT10:AZ39")
 
 
 
    Set myMultipleRange = Union(r1, r2, r3, r4, r5, r6)
    myMultipleRange.Font.Bold = True
myMultipleRange = Union(r1, r2, r3, r4, r5, r6).Copy
 
'myMultipleRange.Copy
 
 Windows("Base de données Reporting.xlsm").Activate
 Sheets("Base de Travail").Select
 
Worksheets("Base de Travail").Range("A65536").End(xlUp).Offset(1, 0).Select
 
ActiveSheet.Paste
Votre est la bien venu si vous connaissez un code permettant de copier une sélection de cellules entre différentes feuilles et les coller dans un autre classeur.
Merci à vous
cordialement