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
| Sub Importe()
Dim dossier As Object, Fichier As Object, Chemin As String, Lg As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("A2:G65536").ClearContents
Chemin = ThisWorkbook.Path
FName = Dir(Chemin & "\" & "*.xls")
Set dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In dossier.Files
NomFichier = Fichier.Name
If Not Fichier.Name = "IMPORT.xlsm" Then
Lg = Range("A65536").End(xlUp).Row + 1
Workbooks.Open Filename:=Chemin & "/" & NomFichier
On Error Resume Next
With Workbooks(NomFichier)
.Sheets("Projet").Range("A2:G" & Range("A65536").End(xlUp).Row - 1).Copy
ThisWorkbook.Sheets("Projet").Range("A" & Lg).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Close
End With
End If
Next
Application.DisplayAlerts = True
End Sub |
Partager