Appliquer macro à plusieurs fichiers d'un répertoire
Bonjour le forum,
J'aurai besoin d'aide pour adapter la macro suivante :
Option Explicit
Public critere%
Sub dispatcher()
Dim Tbl As Variant, data As Variant, i%
Dim dico1 As Object, cle1 As Variant, result1 As Variant
Dim wb As Excel.Workbook
Dim MonRepertoire, Repertoire As FileDialog, racine As String
Dim colonne$
'colonne = Application.InputBox("Entrez la colonne servant de critère de dispatching : ", "Saisie en texte (i.e : A B ...)", Type:=2)
'critere = ActiveSheet.Columns(colonne).Column
UserForm1.Show
If critere = 0 Then Exit Sub
racine = Split(ThisWorkbook.Name, ".")(0)
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
Repertoire.Show
If Repertoire.SelectedItems.Count = 0 Then Exit Sub
MonRepertoire = Repertoire.SelectedItems(1)
data = Cells(Rows.Count, 1).End(xlUp).CurrentRegion
Set dico1 = CreateObject("Scripting.Dictionary")
For i = LBound(data) + 1 To UBound(data) ' hors en-tête
dico1(data(i, critere)) = ""
Next
Application.ScreenUpdating = False
For Each cle1 In dico1.Keys
result1 = filtreArray(data, critere, cle1)
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Model.xlsx")
wb.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(result1, 1), UBound(result1, 2)) = result1
wb.SaveAs (MonRepertoire & "\" & "_" & cle1 & ".xlsx")
wb.Close
Set wb = Nothing
Next
Application.ScreenUpdating = True
MsgBox "Terminé, fichiers sauvegardés sous """ & MonRepertoire & "\" & """ !"
End Sub
Il faudrait que celle-ci s'applique à plusieurs fichiers EXCEL contenus dans un répertoire.
Est-ce possible ?
Un grand merci d'avance pour votre aide.
Invité
Bonjour Sam,
Je ne comprends pas la demande
Le code doit s'appliquer à plusieurs fichiers, mais il s'agit là d'une création de fichiers en fonction du contenu de cellules !?
A+
Oui je me suis rendu compte qu'il y avait un bug dans ma demande.
J'ai ouverts un autre sujet pour tenter de réaliser ce que je souhaite.
Merci.