executer une macro dans plusieurs classeurs fermes

[matteopacino]

Bonjour,

Merci pour les conseils et aides de ce forum.

Pourriez-vous m’aider encore pour ce sujet ?

J'ai créer une macro qui apporte une correction à un classeur.

Mais j’aimerais exécuter cette macro corrective sur plus de 200 classeurs, dans un répertoire donné de mon disque. Alors pour éviter de les ouvrir à chaque fois et d’exécuter la macro, que me conseillez-vous ?

J’ai commencé à regarder sur le forum, et tenté de bidouiller quelques codes trouvés, mais cela ne fonctionne pas.

Merci à vous

 

[WUTED]

Re : executer une macro dans plusieurs classeurs fermes

Bonjour matteopacino,

Est-ce que tu pourrais mettre un fichier joint avec ta macro ou au moins un copier/coller de celle-ci entre balises de codes?

Bonne journée,
WUTED

 

[matteopacino]

Re : executer une macro dans plusieurs classeurs fermes

Bonjour,

Voici le code la macro que je souhaiterai appliquer à mes 200 classeurs fermes.

Sub correction()

Sheets("Total SUB results").Select
Columns("P").Select
'sélectionner 1ere cellule non vide
'Range("B1:B150").Select
For Each c In Range("P120").SpecialCells(xlCellTypeConstants, 23)
If c <> "" Then
c.Select
Exit For
End If
Next

' extension sélection
For Each c In Range("P220").SpecialCells(xlCellTypeConstants, 23)
If c <> "" Then
Range(Selection.Address + "," + c.Address).Select
End If
Next
Selection.Copy
Sheets("Document List").Select
Range("M33:M53").Select
ActiveSheet.Paste
End Sub

 

[WUTED]

Re : executer une macro dans plusieurs classeurs fermes

Re matteopacino,

Que dirais-tu de partir sur un macro comme :

Sub ParcourirFichierXl()
  Dim file As String, chemin as String
  Dim xlApp As New Excel.Application
  Dim xlBook As New Excel.Workbook
  Dim i As Integer

  file = Dir(chemin + "\", vbNormal)

 
  If file = "" Then
    MsgBox "Répertoire vide", vbOKOnly + cvCritical, "Erreur"
    Exit Sub
    Else
    file = Dir(chemin + "\", vbNormal)
    End If
  End If

  Do
    Set xlBook = xlApp.Workbooks.Open(Filename:=file)
    correction xlBook
    xlBook.Close True
    xlApp.Quit
    i = i + 1
    file = Dir(chemin + "\", vbNormal)
    For j = 1 To i
    file = Dir
    Next
  Loop Until file = ""
End Sub

Cette macro se chargeant de parcourir les fichiers excel dans ton répertoire, peu importe le nombre.

Seulement pour cela, il faudrait légèrement modifier ta macro correction, pour qu'elle accepte un paramètre , du genre :

Sub correction(xlBook As Workbook)
    xlBook.Sheets("Total SUB results").Select
    Columns("P:P").Select
    'sélectionner 1ere cellule non vide
    'Range("B1:B150").Select
    For Each c In Range("P1:P20").SpecialCells(xlCellTypeConstants, 23)
        If c <> "" Then
            c.Select
            Exit For
        End If
    Next
    
    ' extension sélection
    For Each c In Range("P2:P20").SpecialCells(xlCellTypeConstants, 23)
        If c <> "" Then
            Range(Selection.Address + "," + c.Address).Select
        End If
    Next
    Selection.Copy
    xlBook.Sheets("Document List").Select
    Range("M33:M53").Select
    xlBook.ActiveSheet.Paste
End Sub

Aux dernières nouvelles, la macro pour parcourir les fichiers était fonctionnelle mais je l'ai un peu modifié donc si y'a un problème j'y jetterai un coup d'oeil.

Bonne journée,
WUTED

 

[matteopacino]

Re : executer une macro dans plusieurs classeurs fermes

Salut WUTED,


Merci mais cela ne fonctionne pas pour le moment :

Sub ParcourirFichierXl()
Dim file As String, chemin As String
Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim i As Integer

file = Dir(("H:\Copy of CQA raw data") + "\", vbNormal)

'vérifie que le répertoire n'est pas vide
If file = "" Then
MsgBox "Répertoire vide", vbOKOnly + cvCritical, "Erreur"
Exit Sub
Else
file = Dir(("H:\Copy of CA data") + "\", vbNormal)
End If


Do

'Cette ligne ne fonctionne pas dans le code

Set xlBook = xlApp.Workbooks.Open(Filename:=file)
correction xlBook xlBook.Close True
xlApp.Quit
i = i + 1
file = Dir(("H:\Copy of CA data") + "\", vbNormal)
For j = 1 To i
file = Dir
Next
Loop Until file = ""
End Sub
Sub correction(xlBook As Workbook)
xlBook.Sheets("Total SUB results").Select
Columns("P").Select
'sélectionner 1ere cellule non vide
'Range("B1:B150").Select
For Each c In Range("P120").SpecialCells(xlCellTypeConstants, 23)
If c <> "" Then
c.Select
Exit For
End If
Next

' extension sélection
For Each c In Range("P220").SpecialCells(xlCellTypeConstants, 23)
If c <> "" Then
Range(Selection.Address + "," + c.Address).Select
End If
Next
Selection.Copy
xlBook.Sheets("Document List").Select
Range("M33:M53").Select
xlBook.ActiveSheet.Paste
End Sub
,

cependant, ma macro n'était pas complète, , elle est en fait plus longue, il ne s'agissait que d'un résumé...

Si j'ai bien compris tu modifies chaque sheets par xlworkbook ? C ça ?

 

[matteopacino]

Re : executer une macro dans plusieurs classeurs fermes

AH juste au début du code, les chemins sont bien identiques !

file = Dir(("H:\Copy of CA data") + "\", vbNormal)

pour les deux.

 

[WUTED]

Re : executer une macro dans plusieurs classeurs fermes

Re matteopaccino,
Remplace la ligne qui ne fonctionne pas par :

Set xlBook = xlApp.Workbooks.Open(Filename:="H:\Copy of CA data\" & file)

Je l'avais mal adapté, il faut le chemin complet du fichier, cette ligne ne devrait plus poser de problèmes.

Ta macro était à la base prévu pour ton classeur courant. En ouvrant un fichier parmi les 200, je stocke dans xlBook le classeur du fichier ouvert, il faut donc que dans ta macro, à chaque fois que t'appelais Sheets par exemple, tu précises bien de quel classeur il s'agit en mettant xlBook.Sheets.

WUTED

 

[matteopacino]

Re : executer une macro dans plusieurs classeurs fermes

Merci de ta réponse.

J'essaie ça dès lundi !