Bonjour à tous,

Pouvez vous m'aider, je souhaiterai que ma procédure balai l'ensemble des fichiers xls d'un répertoire ou se trouverai le classeur et des sous répertoire ou se trouveraient les fichiers ...

je séche un peu là ...

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub Importer()
    Application.DisplayAlerts = False
 
 
    'On efface toutes les données de tous les mois
    For i = 1 To 1
        f = Choose(i, "A TROUVER") '
        derln = Sheets(f).Range("A" & Rows.Count).End(xlUp)(2).Row
        Sheets(f).Range("A10:Z" & derln).ClearContents '
    Next i
    Application.ScreenUpdating = False
 
    'On ouvre successivement tous les fichiers
    Set wa = ActiveWorkbook
    chemin = ThisWorkbook.Path & "\"
    nomFichier = Dir(chemin & "*.xls*")
    Do While Len(nomFichier) > 0
        If nomFichier <> ThisWorkbook.Name Then
            Set classeur = Workbooks.Open(chemin & nomFichier)
 
            'On copie les onglets a trouver
            For i = 1 To 1
                f = Choose(i, "A TROUVER")
                derln = Sheets(f).Range("A" & Rows.Count).End(xlUp)(2).Row
                classeur.Sheets(f).Range("a10:z" & derln).Copy
                    With ThisWorkbook.Sheets(f)
                        lgn = .Range("A" & Rows.Count).End(xlUp)(2).Row
                        ThisWorkbook.Activate
                        .Range("b" & lgn).PasteSpecial xlPasteValues 'cela signifie que je veux les valeurs
                        .Range("b" & lgn).PasteSpecial xlPasteFormats ' cela signifie que je conserve le format
                        derln = .Range("A" & Rows.Count).End(xlUp).Row + 1
                        .Range("A10" & lgn & ":a" & derln) = classeur.Name 'classeur.Sheets(f).Range("A10")
                    End With
                    classeur.Activate
            Next i
            classeur.Close False
        End If
        nomFichier = Dir
    Loop
    MsgBox "Travail terminé."
    Application.DisplayAlerts = True
End Sub
Si une âme charitable peut m'aider ...

merci beaucoup