Discussion :

[modus57]

Bonjour

Voici ma procédure pour copier le code « Worksheet_Change » de la feuille 1 du classeur source, effacer le code « Worksheet_Change » de la feuille1 du classeur destination et coller le code « Worksheet_Change » de la feuille 1 du classeur source vers la feuille1 du classeur de destination de plusieurs classeurs ouverts.

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 CopieCodeFeuilleTousClasseurOuvert()
Dim S As String
Dim ClasseurSource
ClasseurSource = ThisWorkbook.Name
With Workbooks(ClasseurSource).VBProject.VBComponents("Feuil1").CodeModule
    S = .Lines(1, .CountOfLines)
End With
For Each W In Workbooks
    If W.Name <> ClasseurSource Then
        With W.VBProject.VBComponents("Feuil1").CodeModule
.DeleteLines 1, .CountOfLines
.AddFromString S
        End With
    End If
Next W
End Sub

Comment faire pour copier le code « Worksheet_Change » de toutes les feuilles du classeur source, effacer le code « Worksheet_Change » de toutes les feuilles du classeur de destination et coller le code « Worksheet_Change » de toutes les feuilles du classeur source vers de toutes les feuilles du classeur de destination de plusieurs classeurs ouverts.

Pourriez-vous m’aider SVP.

Merci d’avance.

[pijaku]

Bonjour,
Cette procédure ne tiens pas compte de l'ordre des Feuilles. Elle ne teste pas non plus le nombre de feuilles de chaque classeur ouvert. Ce genre de tests est à ajouter...
Je suis donc parti de votre code pour en arriver à :

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
Sub CopieCodeFeuilleTousClasseurOuvert()
 
Dim tablo() As String
Dim I As Integer
Dim ClasseurSource
Dim Wb As Workbook
 
ClasseurSource = ThisWorkbook.Name
 
ReDim tablo(Workbooks(ClasseurSource).Worksheets.Count)
For I = 1 To UBound(tablo)
    With Workbooks(ClasseurSource).VBProject.VBComponents(Sheets(I).Name).CodeModule
        tablo(I) = .Lines(1, .CountOfLines)
    End With
Next
 
For Each Wb In Application.Workbooks
    If Wb.Name <> ClasseurSource Then
        For I = 1 To Wb.Worksheets.Count
            With Wb.VBProject.VBComponents(Sheets(I).Name).CodeModule
                .DeleteLines 1, .CountOfLines
                .AddFromString tablo(I)
            End With
        Next
    End If
Next Wb
End Sub

!!! A tester sur une copie de vos classeurs, bien entendu, car cette macro utilise un .Delete!!!

[modus57]

Bonjour pijaku, le forum

Merci pour ta réponse, j'ai testé ta procédure elle affiche un message (erreur d'exécution '-2147024809 (80070057)' : Argument ou appel de procédure incorrect).

Si j'ajoute après la ligne :

Code :

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

ReDim tablo(Workbooks(ClasseurSource).Worksheets.Count)

Code :

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

On Error Resume Next

Et si je modifie

Code :

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

(Sheets(I).Name)

par

Code :

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

(Sheets(I).CodeName)

La procédure fonctionne, est-ce la bonne solution ??

Elle ne teste pas non plus le nombre de feuilles de chaque classeur ouvert. Ce genre de tests est à ajouter...

Pourrait-tu me donner une petite explication sur le test du nombre de feuilles de chaque classeur ouvert et quelle serait la procédure pour ce type de test.

Merci d'avance pour ta réponse.

Cordiales salutations.

[pijaku]

Dans l'ordre : EDIT : mes réponses sous tes citations...

Si j'ajoute après la ligne :

Code :

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

ReDim tablo(Workbooks(ClasseurSource).Worksheets.Count)

Code :

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

On Error Resume Next

.

Si tu ne sais pas d'ou vient l'erreur, ne la traite pas. On n'utilise "On Error" que lorsque l'on sait pourquoi le code bloque!

Et si je modifie

Code :

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

(Sheets(I).Name)

par

Code :

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

(Sheets(I).CodeName)

La procédure fonctionne, est-ce la bonne solution ??

Par contre si la procédure fonctionne chez toi avec CodeName à la place de Name, ne te prive pas. J'avais testé et le code avec Name fonctionnait impec. le principal étant qu'il fonctionne...

Pourrait-tu me donner une petite explication sur le test du nombre de feuilles de chaque classeur ouvert et quelle serait la procédure pour ce type de test.

En fait, le code que je t'ai adapté, copie le module de classeur1 feuil1 vers classeur2 feuil1, celui de classeur1 feuil2 vers classeur2 feuil2 etc... Supposons que ton classeur de destination (classeur2) ait une ou plusieurs feuilles de plus que le classeur source, puisque l'on boucle sur toutes les feuilles du classeur 2, ta macro va bugguer. Il faut donc penser à cela, à moins que tu ne sois sur au préalable que tes classeurs ont le même nombre de feuilles...

[modus57]

Re bonjour pijaku

Pour le test que j'ai effectué, le nombre de feuilles dans le classeur source est identique au nombre de feuilles de chaque classeur de destination.

Si je ne traite pas l'erreur çà bug sur la ligne

Code :

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

tablo(I) = .Lines(1, .CountOfLines)

Je ne comprends pas pouquoi ?

Effectivement si le ou les classeurs de destination ont une ou plusieurs feuilles de plus que le classeur source la macro bug aussi.

[pijaku]

Bonjour,
Je reviens vers vous tardivement, mais franchement, je ne voyais pas pourquoi ce code fonctionne chez moi et pas chez vous... J'ai donc pris contact avec un éminent spécialiste Excel (Michel_m pour ne pas le citer), afin de voir d'ou venait l'erreur...
Il s'avère que lors de mon copié/collé de code ici même j'ai oublié le principal lorsque l'on parle de variable tableau... Option Base !
Essaye comme ceci :

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
Option Explicit
Option Base 1
Sub CopieCodeFeuilleTousClasseurOuvert()
 
Dim tablo() As String
Dim I As Integer
Dim ClasseurSource
Dim Wb As Workbook
 
ClasseurSource = ThisWorkbook.Name
 
ReDim tablo(Workbooks(ClasseurSource).Worksheets.Count)
For I = 1 To UBound(tablo)
    With Workbooks(ClasseurSource).VBProject.VBComponents(Sheets(I).Name).CodeModule
        tablo(I) = .Lines(1, .CountOfLines)
    End With
Next
 
For Each Wb In Application.Workbooks
    If Wb.Name <> ClasseurSource Then
        For I = 1 To Wb.Worksheets.Count
            With Wb.VBProject.VBComponents(Sheets(I).Name).CodeModule
                .DeleteLines 1, .CountOfLines
                .AddFromString tablo(I)
            End With
        Next
    End If
Next Wb
End Sub

Extrait de la réponse de michel à ton sujet et qui explique clairement cette Option Base :

D'après ce que j'ai pu voir, tu utilises une variable tablo: par défaut, on commence non à 1 mais à 0; donc tu élimines la 1° feuille et Ubound(tablo) renvoie une erreur

soit au dessus de la macro tu écris
option base 1

ou dans la macro
redim tablo(1 to nombrede feuilles)
ou
tu commences par I=0