Exécuter une macro sur tout le répertoire
Bonjour à tous
Je veux exécuter une macro sur tout un répertoire ou au moins créer un bouton qui exécute la macro sur les fichiers ouverts.
Voici ma macro:
Sub SPIP_V()
'
' SPIP_V Macro
'
'
Range("AQ2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(LEFT((RIGHT(RC[-28],LEN(RC[-28])-(FIND(""c."",RC[-28],1))+1)),(FIND(""|"",(RIGHT(RC[-28],LEN(RC[-28])-(FIND(""c."",RC[-28],1))+1))))-1),"""")"
Range("AQ2").Select
Selection.AutoFill Destination:=Range("AQ2:AQ246"), Type:=xlFillDefault
Range("AQ2:AQ246").Select
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(IF(IFERROR(VLOOKUP(RC[-1],'[Macro Variants SPIP.xlsm]Gènes MitoKB V4'!C1:C5,2,FALSE),"""")<>"""",VLOOKUP(RC[-1],'[Macro Variants SPIP.xlsm]Gènes MitoKB V4'!C1:C5,2,FALSE)&"":""&RC[31],VLOOKUP(RC[-1],'[Macro Variants SPIP.xlsm]Gènes MitoKB V4'!C1:C5,3,FALSE)&"":""&RC[31]),"""")"
Range("L2").Select
Selection.AutoFill Destination:=Range("L2:L220"), Type:=xlFillDefault
Range("L2:L220").Select
Columns("L:L").Select
Range("L221").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
PS: je suis nulle en VBA, mais j'essaie d'apprendre petit à petit.
merci beaucoup
Bonjour Mahapharma, bonjour le forum,
Le code ci-dessous va agir sur tous les fichiers Excel du dossier ayant la variable CH comme chemin d'accès. Commence donc par adapter cette variable avant de lancer la macro :
Sub SPIP_V()
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CL As Workbook 'déclare la variable CL (Classeur)
Dim O As Worksheet 'déclare la variable O (Onglet)
CH = "C:\Users\XXX\Documents\xxx\...\" 'ici tu dois mettre le chemin d'accès complet du répertoire où se trouvent les fichiers à traiter
F = dir(CH & "*.xls*") 'définit le premier fichier Excel ayant CH comme chemin d'accès
Do While F <> "" 'exécute tant qu'il existe des fichiers
Set CL = Application.Workbooks.Open(CH & F) 'définit le classeur CL (en l'ouvrant)
Set O = CL.Worksheets(1) 'définit l'onglet O (ici le premier onglet du classseur CL, à adapter à ton cas)
'définit la formule en AQ2 de l'onglet O
O.Range("AQ2").FormulaR1C1 = _
"=IFERROR(LEFT((RIGHT(RC[-28],LEN(RC[-28])-(FIND(""c."",RC[-28],1))+1)),(FIND(""|"",(RIGHT(RC[-28],LEN(RC[-28])-(FIND(""c."",RC[-28],1))+1))))-1),"""")"
'étire la formule jusqu'en AQ246 de l'onglet O
O.Range("AQ2").AutoFill Destination:=O.Range("AQ2:AQ246"), Type:=xlFillDefault
'définit la formule en L2 de l'onglet O
Range("L2").FormulaR1C1 = _
"=IFERROR(IF(IFERROR(VLOOKUP(RC[-1],'[Macro Variants SPIP.xlsm]Gènes MitoKB V4'!C1:C5,2,FALSE),"""")<>"""",VLOOKUP(RC[-1],'[Macro Variants SPIP.xlsm]Gènes MitoKB V4'!C1:C5,2,FALSE)&"":""&RC[31],VLOOKUP(RC[-1],'[Macro Variants SPIP.xlsm]Gènes MitoKB V4'!C1:C5,3,FALSE)&"":""&RC[31]),"""")"
'étire la formule jusqu'en L220 de l'onglet O
Range("L2").AutoFill Destination:=O.Range("L2:L220"), Type:=xlFillDefault
O.Columns("L:L").Copy 'copie la colonne L de l'onglet O
'colle les valeurs dans L1 de l'onglet O
O.Range("L1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
CL.Close True 'ferme le classeur CL en enregistrant les modification
F = dir 'définit le prochain fichier Excel ayant CH comme chemin d'accès
Loop 'boucle
End Sub