Lancer un classeur contenant les macros en arrière plan.

[counterbob]

Bonjour
j'ai 20 classeurs identiques avec listes idPers, nom, postes, jour
ces classeurs sont en réseau
j'ai la même macro dans chaque classeur qui permet de copier les valeurs vers un autre classeur de synthèse.
Le problème c'est que lorsque je modifie la macro je dois le aire sur tous les classeurs.
Je souhaiterai savoir si il est possible d'écrire la macro sur le classeur destination et sur les classeurs sources uniquement l'ouverture du classeur destination en arrièreplan et lancement de la macro ?
Merci pour l'astuce.
Voici le code dans le module de chaque classeur source.

Sub Export()
'ouverture du fichier de destination

Dim ExportPath As String
Dim wbSource As Object
Dim wbExport As Object

Set wbSource = ThisWorkbook
ExportPath = wbSource.Sheets("Parametre").Range("C2") 'recuperation du chemin du fichier de destination
Set wbExport = Workbooks.Open(Filename:=ExportPath)     'ouverture du fichier

'
'vérification de la presence de tout le personnel dans l'etat
'

Dim Badge() As String
Dim Compteur As Integer
Dim BadgeToFind As Integer
Dim BadgeFind As Range
Dim i As Long
Dim val() As Integer
Dim j As Long
'wbExport.Sheets("Liste Personnel").Select
wbSource.Sheets("BD").Activate
Compteur = WorksheetFunction.Count(Range("B:B")) - 1 ' comptage du nombre de personnel

ReDim Badge(Compteur, 2)
'Chargement de la table avec les numero de badge
For i = LBound(Badge, 1) To UBound(Badge, 1)
Badge(i, 1) = Cells(i + 3, 2)
Badge(i, 2) = Cells(i + 3, 2) & Range("E1") & Cells(i + 3, 3) & Cells(i + 3, 1)
Next i


Dim iRow As Integer
'
'recherche de la date
'
Dim dDate As Long

Dim DateFind As Range
Dim iCol As Integer

wbExport.Sheets("Etat 2018").Activate
dDate = wbSource.Sheets("BD").Range("C1") 'date du jour du poste
Application.Goto Reference:=Sheets("Etat 2018").Range("4:4")
Set DateFind = Selection.Find(dDate, lookat:=xlWhole)
    If Not DateFind Is Nothing Then
        'on obtient la colonne du jour à renseigner
        iCol = DateFind.Column
    Else
        'la date n'existe pas on change d'annéee(prevision)
        MsgBox ("Date non trouvée")
       
    End If

'
'recherche du badge pour ecrire le poste
'
Application.Goto Reference:=Sheets("Etat 2018").Range("B:B")
Dim f As Worksheet
Dim ligne As Long
Set f = Sheets("Etat 2018")

For i = 0 To UBound(Badge, 1)
ligne = Range("B65536").End(xlUp).Row

    BadgeToFind = Badge(i, 1) 'Valeur du badge à chercher
   
    Set BadgeFind = Selection.Find(BadgeToFind, lookat:=xlWhole)
    If Not BadgeFind Is Nothing Then
        'on ecrit le repas
        iRow = BadgeFind.Row
        Cells(iRow, iCol) = Badge(i, 2)
    Else
    
        Cells(ligne + 1, 2) = Badge(i, 1)
        Cells(ligne, iCol) = Badge(i, 2)
       
    End If
Next i


'fermeture des classeurs
'

wbSource.Close (True)
wbExport.Close (True)
End Sub

 

[Paritec]

Bonjour Conterbob le forum
oui tu peux avec une commande du style

Application.Run "'Planning Chauffeur.xls'!Module1.fermer"

cela va lancer la macro du fichier Planning Chauffeur dans le module 1 du nom de fermer
attention si ton fichier possède des espaces il faut rajouter ' l'apostrophe devant et derrière le nom du fichier avec l'extension
a+
Papou

 

[counterbob]

Bonjour Conterbob le forum
oui tu peux avec une commande du style

Application.Run "'Planning Chauffeur.xls'!Module1.fermer"

cela va lancer la macro du fichier Planning Chauffeur dans le module 1 du nom de fermer
attention si ton fichier possède des espaces il faut rajouter ' l'apostrophe devant et derrière le nom du fichier avec l'extension
a+
Papou

Bonjour
Merci Papou
@+