Mise à jour d'une Macro
Bonjour
j'ai MAJ une macro est l'adapter pour mon besoin dans ce fichier sauf que j'arrive pas a faire 2 chose:
d'abord j'explique le fonctionnement de la macro :
-1 elle ouvre un fichier X
-2 lance une Macro update_formules dans le fichier X
-3 ferme le fichier X
Alors ce que je veux ajouter et sera comme suite :
1 - ouvre le fichier X
2 - lance la macro update_forumule
3 - me sauvegarde les données de la cellule IZ4 de fichier X dans la cellule D8 de fichier Y (le fichier d'ou je lance ma macro)
4 - me sauvegarde les données de la cellule IZ5 de fichier X dans la cellule D9 de fichier Y (le fichier d'ou je lance ma macro)
5- sauvegarde le fichier X
6- ferme le fichier X et j'aurai mes information dans les cellules D8 et D9 qui correspondent a la Cellule IZ4 et IZ5 de fichier X
voila la macro :
Sub updateT1()
Set twb = ThisWorkbook
Set wsm = twb.Sheets("index") 'feuille index avec liste des fichiers à MAJ
dlm = 8 '1er fichier a MAJ
i = 8
nf = wsm.Cells(i, 2)
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set wb = Workbooks.Open(nf, 0) 'on ouvre le fichier
Application.Calculation = xlCalculationAutomatic
With wb.Sheets("Planning")
If .AutoFilterMode Then
.Cells.AutoFilter
End If
End With
rc = ("'" & wb.Name & "'!Update_Formule_Trame")
Application.DisplayAlerts = True
Application.Run rc 'on lance MAJ des Formules
wb.Close False 'on ferme le fichier planning
MsgBox "Update Formule OK"
End SubMerci
Bonjour,
Si j'ai bien compris, il suffit d'ajouter une simple ligne, mais où ça ?
Voici un code avec 2 possibilités :
Sub updateT1()
Dim WbBase as workbook, WbPlanning as workbook
Dim WsIndex as worksheet, WsPlanning as worksheet
Dim dlm%, i%
Dim nf$, rc$
Set WbBase = ThisWorkbook
Set WsIndex = WbBase.Sheets("index") 'feuille index avec liste des fichiers à MAJ
dlm = 8 '1er fichier a MAJ
i = 8
nf = WsIndex.Cells(i, 2).value
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set WbPlanning = Workbooks.Open(nf, 0) 'on ouvre le fichier
Set WsPlanning = WbPlanning.Sheets("Planning")
Application.Calculation = xlCalculationAutomatic
With WsPlanning
If .AutoFilterMode Then .Cells.AutoFilter
'.range("IZ4:IZ5").copy destination:=WsIndex.range("D8:D9") 'ici ?
End With
rc = "'" & WbPlanning.Name & "'!Update_Formule_Trame"
Application.DisplayAlerts = True
Application.Run (rc) 'on lance MAJ des Formules
WsPlanning.range("IZ4:IZ5").copy destination:=WsIndex.range("D8:D9") 'plutot ici je pense (copie IZ4:IZ5 de planning en D8:D9 de index)
WbPlanning.Close savechanges:=True 'on ferme le fichier planning avec sauvegarde
MsgBox "Update Formule OK"
End SubCdlt,
bonjour
Merci 3GB pour votre aide voici le fichier possible pour mieux me comprendre
je veux juste remplacer les formule en D8 et E8 et les intégrer dans la macro pour éviter la liaison au fichier
quand je lance la macro elle lance une autre macro dans la fichier X qui est le fichier planning macro déjà existante donc la lance et récupérer les données ou résultat de cette macro dans les cellule D8 et E8
IZ4 de fichier planning dans la cellule D8
IZ5 de fichier planning dans la cellule E8
le chemin de fichier a ouvrir dans la cellule B8
Si j'ai bien compris, il faut les valeurs et une transposition :
Sub updateT1()
Dim WbBase as workbook, WbPlanning as workbook
Dim WsIndex as worksheet, WsPlanning as worksheet
Dim dlm%, i%
Dim nf$, rc$
Set WbBase = ThisWorkbook
Set WsIndex = WbBase.Sheets("index") 'feuille index avec liste des fichiers à MAJ
dlm = 8 '1er fichier a MAJ
i = 8
nf = WsIndex.Cells(i, 2).value
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set WbPlanning = Workbooks.Open(nf, 0) 'on ouvre le fichier
Set WsPlanning = WbPlanning.Sheets("Planning")
Application.Calculation = xlCalculationAutomatic
With WsPlanning
If .AutoFilterMode Then .Cells.AutoFilter
End With
rc = "'" & WbPlanning.Name & "'!Update_Formule_Trame"
Application.DisplayAlerts = True
Application.Run (rc) 'on lance MAJ des Formules
WsPlanning.range("IZ4:IZ5").copy
'WbBase.activate si besoin pour collage spécial
WsIndex.range("D8:D9").PasteSpecial Paste:=xlpastevalues, transpose:=true 'plutot ici je pense (copie IZ4:IZ5 de planning en D8:E8 de index)
WbPlanning.Close savechanges:=True 'on ferme le fichier planning avec sauvegarde
MsgBox "Update Formule OK"
End SubCdlt,
Cependant, je ne comprends pas ces lignes
dlm = 8 '1er fichier a MAJ
i = 8Dans quels cas i varie ? pourquoi de 8 à 12 ? Et pourquoi plusieurs macros identiques ?
parfait :)
bon comme je ne suis pas Pro de VBA j'ai juste modifier une macro existant pour la faire adapter a mon besoin
parfois je doit faire la MAJ 1 seule trame parfois de 3 ou 4 c'est pour cela je fait une macro et la copier +ieurs fois si je doit lancer une MAJ sur 3 ou 4 fichier
comme je connais pas l'astuce je fait avec le temps de la fixer
Merci
D'accord, je comprends mieux. Il y aurait une solution de ce type mais je ne sais pas si elle correspondrait avec votre fichier
Sub updateT1()
Dim WbBase as workbook, WbPlanning as workbook
Dim WsIndex as worksheet, WsPlanning as worksheet
Dim i as byte
Dim nf$, rc$
Set WbBase = ThisWorkbook
Set WsIndex = WbBase.Sheets("index") 'feuille index avec liste des fichiers à MAJ
for i = 8 to 12
if WsIndex.Cells(i, 2).value Like "*.*" then
nf = WsIndex.Cells(i, 2).value
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set WbPlanning = Workbooks.Open(nf, 0) 'on ouvre le fichier
Set WsPlanning = WbPlanning.Sheets("Planning")
Application.Calculation = xlCalculationAutomatic
With WsPlanning
If .AutoFilterMode Then .Cells.AutoFilter
End With
rc = "'" & WbPlanning.Name & "'!Update_Formule_Trame"
Application.DisplayAlerts = True
Application.Run (rc) 'on lance MAJ des Formules
WsPlanning.range("IZ4:IZ5").copy
'WbBase.activate si besoin pour collage spécial
WsIndex.range("D"& i & ":E" & i).PasteSpecial Paste:=xlpastevalues, transpose:=true 'copie IZ4:IZ5 de planning
WbPlanning.Close savechanges:=True 'on ferme le fichier planning avec sauvegarde
end if
next i
MsgBox "Update Formule OK"
End SubAvec vos noms de fichiers en B8, ..., B12 et les valeurs collées en D:E ligne 8 à 12.
Bonne continuation,
parfait :)
je vais la tester et revenir vers vous mais de vue me semble OK
MErci 3GB c'est Nikel :)