Sub Importa()
Dim fd As FileDialog
Dim PathOfSelectedFolder As String
Dim SelectedFolder
Dim SelectedFolderTemp
Dim MyPath As FileDialog
Dim plage1 As String
Dim plage2, plage3 As String
Dim cl, myrange As Range
Dim fs
Dim ExtraSlash
ExtraSlash = "\"
Dim MyFile
'enregistrer une copie du classeur avant modification
Call sauver
'Ouvrir le repertoir
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker)
With MyPath
'Ouvrir une fenetre flottante
.AllowMultiSelect = False
If .Show Then
'selection de dossier
'Loop dans le dossier choisi
For Each SelectedFolder In .SelectedItems
'Nom du dossier selectionné
PathOfSelectedFolder = SelectedFolder & ExtraSlash
Set fs = CreateObject("Scripting.FileSystemObject")
Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder)
'Loop dans les fichiers du dossier
For Each MyFile In SelectedFolderTemp.Files
'Nom du fichier commmencant par "parc" et ayant un mot de passe "123"
If InStr(MyFile, "parc") > 0 Then
Workbooks.Open Filename:=MyFile, Password:="123"
nm = MyFile.Name
'Extraction de la date à partir du nom du classeur
nomm = Left(Right(nm, 15), 10)
jj = Left(nomm, 2)
mm = Right(Left(nomm, 5), 2)
aaaa = Right(nomm, 4)
dte = jj & "/" & mm & "/" & aaaa
nmm = CDate(dte)
Sheets("IMPRESSION").Select
Sheets("IMPRESSION").Range("k1").Value = nmm
'Selection des colonnes F et H pour afficher la colonne G
Columns("F:H").Select
Selection.EntireColumn.Hidden = False
Cells.Find(What:="FLOTTE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
ActiveCell.Offset(1, -3).Select
Selection.Name = "dcbl"
ActiveCell.Offset(0, 7).Select
Selection.Name = "cbl"
ActiveCell.FormulaR1C1 = "=R1C11-RC[-6]"
Range("dcbl").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 7).Select
Selection.Name = "fcbl"
Range("cbl", "fcbl").Select
Selection.FillDown
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("dcbl", "fcbl").Select
Selection.Copy
'ActiveWindow.Close
'Windows(MyFile.Name).Activate
Windows(ThisWorkbook.Name).Activate
Sheets("BD").Range("B65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.PasteSpecial
Sheets("BD").Range("B65536").Select
Selection.End(xlUp).Select
Selection.Offset(0, -1).Select
Set myrange = Range(Selection, Selection.End(xlUp).Offset(1, 0))
For Each cl In myrange
cl.Activate
With ActiveCell
.NumberFormat = "dd/mm/yyyy" 'ou autre format Date
.Value = nmm
End With
'ActiveCell.Value = .NumberFormat = "m/d/yyyy"
Next
Windows(MyFile.Name).Activate
ActiveWorkbook.Save
ActiveWindow.Close
End If
Next
Next
End If
End With
ActiveWorkbook.Save
End Sub