counterbob
XLDnaute Nouveau
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.
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.
Code:
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