Merci pour ta réactivité.
Voici ce que cela donne. Mais probléme dans la file d'attente il ont tous 26 pages lol (une seul normalement enfin 4) tu a une idée?
Merci d'avance
Function ChoixDossier()
If Val(Application.Version) >= 10 Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & "\"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Else
ChoixDossier = InputBox("Répertoire?")
End If
End Function
Sub Parcourir_dossier(chemin As String, fichier_source As String)
Dim Fso As Object
Dim SourceFolder As Object
' Dim SubFolder As Scripting.Folder
Dim FileItem As Object
Dim fichier_en_traitement As String
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(chemin)
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
fichier_en_traitement = FileItem.Name ' on recupere le nom du fichier
Workbooks.Open chemin & "\" & fichier_en_traitement
Sheets(6).PrintOut , copies:=4
ActiveWorkbook.Close False
Next FileItem
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
'For Each SubFolder In SourceFolder.SubFolders
' Parcourir_dossier SubFolder.Path, (fichier_source)
'Next SubFolder
End Sub
Sub recuperation_donnees()
Dim nom_fichier_source As String
Dim chemin, plage1, plage2, nomfeuille As String
Dim i As Integer
Application.ScreenUpdating = False ' mise a jour de l'affichage
Application.DisplayAlerts = False
Sheets(1).Activate
MsgBox ("Vous devez renseigner le dossier contenant tous les fichiers")
chemin = ChoixDossier 'demande a l'utilisateur de saisir le repertoire ou se trouve les fichiers
If chemin <> "" Then Parcourir_dossier (chemin), (nom_fichier_source)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub