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 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
|
Sub Test()
Dim Cls As Workbook
Dim Fe As Worksheet
Dim Plage As Range
Dim Tbl() As String
Dim I As Integer
Dim Chemin As String
Dim DerLigne As Long
'adapter le chemin du dossier où se trouvent les classeurs cibles...
Chemin = "E:\Dossier\"
'appel de la fonction pour récupérer les noms des classeurs
Tbl = EnumFichiers(Chemin, ".xls*") 'astérisque si tous les fichiers Excel (.xls, .xlsx, .xlsm, etc...)
'si initialisé (au moins 1 classeur)
If Not (Not Tbl) Then
'boucle sur le tableau
For I = 1 To UBound(Tbl)
'ouvre le classeur
Set Cls = Workbooks.Open(Chemin & Tbl(I))
'défini la plage en colonne A à partir de A1 sur la première feuille du classeur
With Cls.Worksheets(1): Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
With ThisWorkbook.Worksheets(1) 'sur la 1ère feuille du classeur
DerLigne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
If DerLigne = 2 And .Range("A1").Value = "" Then DerLigne = 1
.Range(.Cells(DerLigne, 1), .Cells(DerLigne + Plage.Rows.Count - 1, 1)).Value = Plage.Value
End With
'referme
Cls.Close False
Next I
End If
End Sub
Function EnumFichiers(Chemin As String, Extension As String) As String()
Dim TableauFichiers() As String
Dim Fichier As String
Dim I As Integer
'complète le chemin le cas échéant
If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
'récupère seulement les fichiers Excel
Fichier = Dir(Chemin & "*" & Extension)
'boucle sur les fichiers du dossier
Do While (Len(Fichier) > 0)
I = I + 1
ReDim Preserve TableauFichiers(1 To I)
TableauFichiers(I) = Fichier
Fichier = Dir()
Loop
'retourne le tableau des noms de fichiers
EnumFichiers = TableauFichiers()
End Function |
Partager