importer les dernieres lignes de fichiers fermé

Sub Import()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Dim Colonne As Integer

Dim fd As Office.FileDialog, SRC_WBK As Workbook 'ajout
Dim DerDate As Range, Dest_Rng As Range, DerLig& ' ajout
Set Dest_Rng = ThisWorkbook.Sheets("Point J").Cells(Rows.Count, "A").End(xlUp)
Dest_Rng.Offset(, 1).Resize(136, 5) = Empty ' ajout vidage tableau

'ouverture de la fenêtre de choix du répertoire
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
'Si l'utilisateur annule sans choisir
If objFolder Is Nothing Then
'message
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else 'sinon
'Chemin = répertoire choisi
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
'Choix du 1er fichier
fichier = Dir(Chemin & "Cahier*.xls*")

'on boucle sur tous les fichiers excel du répertoire choisi
' Application.ScreenUpdating = False
End If
Do While Len(fichier) > 0
If fichier <> ThisWorkbook.Name Then

Set SRC_WBK = ThisWorkbook


With SRC_WBK.Sheets(1)
'détermination de la dernière ligne non vide
DerLig = .Cells.Find("*", SearchOrder:=1, SearchDirection:=2).Row
'recherche de la date du jour
Set DerDate = .Columns("A:A").Find(What:=Date, After:=.Cells(1, 1), LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'recopie des données
.Range(.Cells(DerDate.Row, "A"), .Cells(DerLig, "E")).Copy Dest_Rng.Offset(, 1)
End With
Dest_Rng = Split(SRC_WBK.Name, ".")(0)
SRC_WBK.Close False
Dest_Rng.Select


End If

fichier = Dir()
Loop
'Application.ScreenUpdating = tree
End Sub

Cliquez pour agrandir...