[CHERCHE] Macro pour controler/modifier

Option Explicit

Sub ImporterDates()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)

If objFolder Is Nothing Then
    MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
    Columns(1).NumberFormat = "m/d/yyyy"
    Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
    [B1] = Chemin
    fichier = Dir(Chemin & "*.xls")
    Do While Len(fichier) > 0
        ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1"
        With Sheets("Feuil2")
            .[A1] = "=Plage"
            .[A1].Copy
            Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = fichier
        End With
        fichier = Dir()
    Loop
End If
End Sub

Sub ExporterDates()
Dim Chemin As String, fichier As String
Dim maDate As Date
Dim Lign As Long, DrLig As Long

Application.ScreenUpdating = False
With Sheets("Feuil1")
    DrLig = .Range("A" & Rows.Count).End(xlUp).Row
    For Lign = 2 To DrLig
        maDate = .Cells(Lign, 1).Value
        If Not IsDate(maDate) Then
            MsgBox "Format de date incorrecte à la ligne : " & Lign
            Exit Sub
        End If
        Chemin = [B1]
        fichier = .Cells(Lign, 2).Value
        Workbooks.Open Chemin & fichier
        With ActiveWorkbook
            .Sheets("Feuil1").Range("A1") = CDate(maDate)
            .Save
            .Close
        End With
    Next
End With
Application.ScreenUpdating = True
End Sub