Discussion :

[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).
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 :

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

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

[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

[aweb]

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 :

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
' 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

[Patrice740]

Bonjour,

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.

[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 ?

[mercatog]

Bonjour

Exemple à adapter

L'utilisateur choisit le fichier...

Code :

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

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

[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

[aweb]

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 :

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

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

[aweb]

Désolé d'insister

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

Code :

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

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

[mercatog]

Wbk est le classeur de destination

Code :

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

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

[aweb]

Parfait

Cela fonctionne parfaitement maintenant.

Merci beaucoup !

[mercatog]

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.

[aweb]

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 :

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

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 :

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
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

[mercatog]

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 :

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
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

[aweb]

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.

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
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)

[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.

[aweb]

Su le 1er classeur, cela fait 232 caractères

[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 ???

[mercatog]

Oups

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

Code :

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

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

[aweb]

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 :

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

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)