Sub Recherche()
If Left(ActiveSheet.Name, 5) <> "Ligne" Then Exit Sub
Dim chemin$, fich$, d1&, h1#, d2&, h2#, deb As Range, d, t, rest(), n&, i&, h#, j%
chemin = ThisWorkbook.Path & "\" 'à adapter
fich = Dir(chemin & ActiveSheet.Name & "\*.csv") '1er fichier du sous-dossier
d1 = [B2]: h1 = d1 + [C2]: d2 = [B3]: h2 = d2 + [C3]
Set deb = [A28]
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si un fichier est déjà ouvert
deb.Resize(Rows.Count - deb.Row + 1, 8) = "" 'RAZ
While fich <> ""
d = Mid(fich, 5, 2) & "/" & Mid(fich, 3, 2) & "/" & Left(fich, 2)
If IsDate(d) Then
d = CDbl(CDate(d))
If d >= d1 And d <= d2 Then
With Workbooks.Open(chemin & ActiveSheet.Name & "\" & fich)
With .Sheets(1).[A1].CurrentRegion
.TextToColumns .Cells(1), xlDelimited, Semicolon:=True, Other:=False
t = .Offset(1).Resize(, 8)
ReDim rest(1 To UBound(t), 1 To 8)
n = 0
For i = 1 To UBound(t) - 1
h = t(i, 1) + t(i, 2)
If h >= h1 And h <= h2 Then
n = n + 1
rest(n, 1) = h 'Date/heure en colonne A
For j = 1 To 6
rest(n, j + 1) = t(i, j)
Next
rest(n, 8) = fich 'facultatif, nom du fichier en colonne H
End If
Next
If n Then 'restitution
deb.Resize(n, 8) = rest
Set deb = deb(n + 1)
End If
End With
.Close False
End With
End If
End If
fich = Dir 'fichier suivant du sous-dossier
Wend
Range("A28:H" & Rows.Count).Sort [A28], Header:=xlNo 'tri
With ActiveSheet.UsedRange: End With 'actualise les barres de défilement
End Sub