Utiliser une même macro dans des classeurs différents

Version imprimable

Voir 40 message(s) de cette discussion en une page

Bonjour
J'ai une macro qui fonctionne dans un classeur. Elle consiste à copier les valeurs d'une feuille d'un classeur de base, et de les coller dans le classeur de destination.
J'aimerai pouvoir utiliser cette macro sur beaucoup d'autres classeurs de destinations (qui ne portent pas le même nom évidement).
Comment dois-je faire pour lancer cette macro sans qu'elle ne soit attacher à un seul classeur destination?

Voici le code que j'ai mis pour un classeur, mais je ne peux pas l'utiliser pour les autres.

Je voulais utiliser quelque chose comme Theseworkbooks ou autres, mais je ne trouve pas.

D'avance Merci
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub CopierCollerBaseMP() ' ' CopierCollerBaseMP Macro ' Windows("Base.xlsx").Activate Sheets("Base MP").Select Cells.Select Range("A1152").Activate Selection.Copy Windows("Destination1.xlsm").Activate Cells.Select ActiveSheet.Paste Range("A1").Select End Sub

20/11/2019, 18h36
Philippe Tulliez
Bonjour,
Si l'on souhaite utiliser des procédures (Function ou Sub) quelque soit le classeur ouvert, deux possibilités
- Créer un classeur Personnal.xlsb (Automatiquement créé si l'on choisi cette option lors de l'enregistrement d'une macro)
- Sauver le classeur contenant une macro comme Macro complémentaire (fichier suffixé xlam)
Maintenant, s'il s'agit d'écrire ou de lire dans un classeur qui est autre que le classeur où se trouve le code VBA (ThisWorkbook), il faut simplement donner le bon nom du classeur (Workbooks("Toto.xlsx")) par exemple

Bonjour

Si j'ai bien compris, il faudrait que je change le nom de mon classeur de destination à chaque fois ?

"Maintenant, s'il s'agit d'écrire ou de lire dans un classeur qui est autre que le classeur où se trouve le code VBA (ThisWorkbook), il faut simplement donner le bon nom du classeur (Workbooks("Toto.xlsx")) par exemple"

C'est justement ce que je cherche à éviter.
J'ai environ 200 classeurs excel à ouvrir et dans lequel je lancerai la même macro.
Je voulais donc éviter de devoir modifier le nom du classeur dans la macro pour chacun d'eux... (en bleu dans le code ci-dessous)
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 ' Copier la base MP 2020 ' Windows("Cotation Budget 2020 Test.xlsx").Activate Sheets("Base MP").Select Cells.Select Selection.Copy Windows("PF-GE0053-1230_LACT.REF B2B15G_EG_20181119_modif_MSCV.xlsm").Activate Sheets("Base MP").Select Range("A1").Select ActiveSheet.Paste Range("J10:J177").Select Application.CutCopyMode = False Selection.Copy Range("F10").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select

21/11/2019, 09h37
Patrice740

Bonjour,

Citation:

Envoyé par aweb

Bonjour
J'ai une macro qui fonctionne dans un classeur. Elle consiste à copier les valeurs d'une feuille d'un classeur de base, et de les coller dans le classeur de destination.
J'aimerai pouvoir utiliser cette macro sur beaucoup d'autres classeurs de destinations (qui ne portent pas le même nom évidement).

Il suffit de mettre la macro dans le classeur de base.
Quelques conseils :
- Éviter d'utiliser .Select, dans ce cas c'est inutile.
- Une fenêtre n'est pas un classeur, utiliser le bon objet pour éviter les erreurs.
21/11/2019, 09h58
aweb

Bonjour Patrice740

Je comprends, mais comment va s’exécuter la macro dans le fichier de destination sans lui donner le nom d'un ancien fichier de destination ?

Bonjour

Exemple à adapter

L'utilisateur choisit le fichier...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub Test()
Dim Wbk As Workbook
Dim Fichier
 
Fichier = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx")
If Fichier <> False Then
    Set Wbk = Workbooks.Open(Fichier)
    Wbk.Worksheets("Source").Range("A1:D25").Copy ThisWorkbook.Worksheets("Destination").Range("X3")
    Wbk.Close False
    Set Wbk = Nothing
End If
End Sub

21/11/2019, 10h45
Igloobel

Bonjour,

Comme te l'a dis Philippe Tulliez

Si tu crées un classeur .xlam (classeur spécifique de macros complémentaires) tu dois l'installer dans les compléments et pour cela rien de plus simple.
- Developpeur - Compléments - Compléments
- Clic sur bouton "Parcourir ..."
- Sélectionner le classeur .xlam
- Clic sur bouton "Oui"

Une fois fait les macros contenus dans ce classeur sont disponibles pour tous tes classeurs que tu ouvrirais, même des nouveaux, même des classeurs sans macro (.xlsx)

Tu appelles la macro et c'est tout

c'est la meilleure solution.
Maintenance facile et disponible en réseau à plusieurs en même temps sans soucis :ptdr:

Bonjour

OK, j'ai réussi à utiliser la macro depuis un autre classeur (ma base par exemple) ou encore mieux depuis les compléments en macro complémentaires.

Mais je n'arrive toujours pas à adapter la proposition de Mercatog

Il me propose bien de choisir et d'ouvrir le classeur excel destination.
Mais après, il ne copie pas les valeurs de la feuille "Base MP" du classeur source, dans la feuille "Base MP" du classeur destination.
Voici le code que j'ai rentré.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub MAJOutilCotation2020pourPilejeV2() ' ' Copier la base MP 2020 ' Dim Wbk As Workbook Dim Fichier Fichier = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx") If Fichier <> False Then Set Wbk = Workbooks.Open(Fichier) Wbk.Worksheets("Base MP").Range("A1:BZ50000").Copy ThisWorkbook.Worksheets("Base MP").Range("A1:BZ50000") End If End Sub

21/11/2019, 11h30
aweb

Désolé d'insister :oops:

Il n'existe pas de code qui remplacerait (dans mon code initial)

Code:

Windows("destination25.xls").Activate

par quelque chose comme "le classeur ouvert en-cours" ?

Car dans ma macro, j'ai d'autres fonctions à exécuter, et l'idée que j'avais était que j'ouvre en premier le classeur destination et qu'ensuite j'exécute toutes les macros.

Après, il est vrai que je peux commencer par ouvrir le fichier destination par l'invitation de la macro, et que j'exécute ensuite toutes les macros.
Dans ce cas, il manquerait juste de réussir à copier, ce que je n'ai pas réussi à faire dans mon post précédent.

Merci encore
21/11/2019, 11h44
mercatog

Wbk est le classeur de destination

Code:

ThisWorkbook.Worksheets("Base MP").Range("A1:BZ50000").Copy Wbk.Worksheets("Base MP").Range("A1")
21/11/2019, 12h19
aweb

Parfait

Cela fonctionne parfaitement maintenant.

Merci beaucoup !
21/11/2019, 14h13
mercatog

Citation:

Envoyé par aweb

Parfait

Cela fonctionne parfaitement ~~maintenant.~~

Merci beaucoup !

Non, ça devrait fonctionner dès le départ vu que te limite à un copier/ coller sans chercher à comprendre qui fait quoi et comment.

Re-bonjour

Désolé Mercatog. Je t'assure que je cherche, et que je ne limite pas à un simple copier coller, mais c'est que je suis vraiment débutant, et que je ne comprends pas tout. J'essaie de me débrouiller, mais ce n'est pas simple. C'est bien pour çà que je fais appel à vous : experts.

Pour aller au bout de mon projet, j'aimerais que la macro se lance pour tous les classeurs d'un répertoire.
Dans ce répertoire, j'aurai tous mes classeurs de destinations (environ 200 classeurs) sur lesquels je souhaite que la macro s'applique.
Les lancer tous automatiquement m'éviterai de devoir les ouvrir un par un.

J'avais fait quelque chose comme çà il y a bien longtemps, donc en reprenant des bouts par ci par là, voilà l'ensemble de mon code, mais çà bug à la ligne 42 du code.

Code:

ThisWorkbook.Worksheets("Base MP").Range("A1:BZ50000").Copy Wbk.Worksheets("Base MP").Range("A1")

Il m'indique "Erreur d'exécution 91 : Variable objet ou variable de bloc With non définie

voilà l'ensemble de mon code.

D'avance Merci encore

Code:

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
Sub MAJOutilCotation2020pourPileje()
'
 
'declaration de variable
    Dim Wbk As Workbook
 
    Dim objFSO As Object
    Dim objDossier As Object
    Dim objFichier As Object
 
    'initialisation des variables
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'definit le repertoire ou se trouvent les feuilles a traiter
    Set objDossier = objFSO.GetFolder("\\MARS-FIC1\3iStBonnet\Pole_Administratif_Financier\Gestion\Partage Gestion\% Cotation Octobre 2018\Pileje Labo V2\Anthony - Copie")
 
    'pour chaque classeur dans le répertoire
    For Each objFichier In objDossier.Files
        'ouvre le classeur
        Workbooks.Open objFichier
 
 
 
' Enlever la protection de toutes les feuilles
'
    Dim Feuil As Worksheet
    For Each Feuil In ThisWorkbook.Worksheets
    Feuil.Unprotect ("profit")
    Next Feuil
 
 
' afficher la feuille BaseMP
'
 
    Sheets("Base MP").Visible = True
 
 
 
' Copier la base MP 2020
'
 
 
    ThisWorkbook.Worksheets("Base MP").Range("A1:BZ50000").Copy Wbk.Worksheets("Base MP").Range("A1")
    Sheets("Base MP").Select
    Range("J10:J177").Select
    Selection.Copy
    Range("F10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
 
 
 
' Modifier les données sur les feuilles synthèses
 
Dim xlwksheet As Worksheet
 
  For Each xlwksheet In ActiveWorkbook.Sheets
    If xlwksheet.Name Like "Synt*" Then
      With xlwksheet
        .Range("E44").Value = 0.473
        .Range("E46").Value = 0.432
        .Range("E44,E46").NumberFormat = "#0.0%"
 
        .Range("D27").Formula = "=D19*0.072"
        .Range("D33").Formula = "=IF(RC[-1]=""OUI"",IF(R[-25]C[-1]=0,0,713/R[-25]C[-1]),0)"
      End With
    End If
  Next
 
 
 
 
' Protéger toutes les feuilles
'
    Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
    Sh.Protect ("profit")
    Next Sh
 
 
 
' Masquer la feuille Base MP
'
    Sheets("Base MP").Select
    ActiveWindow.SelectedSheets.Visible = False
    Worksheets(1).Select
    Range("A1").Select
 
 
' Enregistre le classeur au même endroit
 
    ActiveWorkbook.Save
    ActiveWorkbook.Close
 
  Next
 
 
End Sub

Tu fais du n'importe quoi. Sérieux.

Arrête un moment et essaie de comprendre le minimum du langage et de la manière de construire ton code.

Les Select sont inutiles
Tu travailles avec plusieurs classeur, il faudra rapporter les Objets Sheet et Worksheet à leur classeur père
Il faudra de ensuite rapporter les objets Range et Cells à leur feuille mère

Je ferai comme ceci.
A toi d'adapter la Sub Traitement
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub MAJOutilCotation2020pourPileje() Dim Rep As String, Fichier As String Rep = "\\MARS-FIC1\3iStBonnet\Pole_Administratif_Financier\Gestion\Partage Gestion\% Cotation Octobre 2018\Pileje Labo V2\Anthony - Copie" Fichier = Dir(Rep & "\*.xlsx") Do While Fichier <> "" Call Traitement(Fichier) Fichier = Dir() Loop End Sub Private Sub Traitement(ByVal Classeur As String) Dim Wbk As Workbook Set Wbk = Workbooks.Open(Classeur) With ThisWorkbook.Worksheets("Base MP") .Range("A1:BZ50000").Copy Wbk.Worksheets("Base MP").Range("A1") '....Suite sans les select 'Wbk étant la classeur desination 'Thisworkbook étant le classeur contenant cette macro End With Wbk.Close False Set Wbk = Nothing End Sub

1 pièce(s) jointe(s)

Bonjour

Je m'excuse Mercatog, je répète que ce n'est pas du tout mon métier, et que j'essaie de comprendre, mais ce n'est tout de même pas si simple. Merci de ta compréhension.

J'ai mis çà dans mon code, mais il me dit qu'il ne trouve pas le nom du classeur. il s'arrête à la dernière ligne de cette copie de code.
Ce que je trouve bizarre, c'est qu'il indique le nom du classeur tout de même.
Bien évidement, j'ai vérifié le chemin, et c'est le bon.

Pièce jointe 519105
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Sub MAJOutilCotation2020pourPileje() Dim Rep As String, Fichier As String Rep = "\\MARS-FIC1\3iStBonnet\Pole_Administratif_Financier\Gestion\Partage Gestion\% Cotation Octobre 2018\Pileje Labo V2\Anthony - Copie" Fichier = Dir(Rep & "\*.xlsx") Do While Fichier <> "" Call Traitement(Fichier) Filename = Dir() Loop End Sub Private Sub Traitement(ByVal Classeur As String) Dim Wbk As Workbook Set Wbk = Workbooks.Open(Classeur)

22/11/2019, 14h52
mercatog

Quel est la longueur du chemin complet du fichier en question: chemin + nom fichier + extension.

Tu as ce problème pour tous les fichiers ou quelques uns.

En cours de développement, on travaille sur une version allégée: répertoire en local. Quand tout est ok, on teste sur le réel.
22/11/2019, 14h57
aweb

Su le 1er classeur, cela fait 232 caractères
22/11/2019, 15h05
aweb

Je viens de faire le test, en mettant 4 classeurs dans un répertoire sur le disque C:

Le truc bizarre, c'est qu'il trouve le 1er classeur une première fois, mais la macro ne va pas au bout pour autre chose.

Je relance à nouveau, et là le même message comme quoi il ne trouve plus le fichier ???

Oups

Remplacement en ligne 8 Filename par Fichier et ajout du répertoire

Code:

1
2
3
4
5
6
7
8
9
10
Sub MAJOutilCotation2020pourPileje()
Dim Rep As String, Fichier As String
 
Rep = "\\MARS-FIC1\3iStBonnet\Pole_Administratif_Financier\Gestion\Partage Gestion\% Cotation Octobre 2018\Pileje Labo V2\Anthony - Copie"
Fichier = Dir(Rep & "\*.xlsx")
Do While Fichier <> ""
    Call Traitement(Rep &" \"&Fichier)
    Fichier = Dir()
Loop
End Sub

Je viens de modifier la ligne 8 du code, et modifier le répertoire pour mettre les classeurs sur le C, et toujours le même message, et il s'arrête à la ligne 15 de ce code.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub MAJOutilCotation2020pourPileje() Dim Rep As String, Fichier As String Rep = "C:\TestAnthony" Fichier = Dir(Rep & "\*.xlsx") Do While Fichier <> "" Call Traitement(Rep & " \" & Fichier) Fichier = Dir() Loop End Sub Private Sub Traitement(ByVal Classeur As String) Dim Wbk As Workbook Set Wbk = Workbooks.Open(Classeur)

Voir 40 message(s) de cette discussion en une page