XL 2013 Inversion mois et date ?

Sub Recup_donnees_pour_TDB()

'Déclaration des variables
Dim nbr As Integer
Dim Derlig As Integer
Dim x As String
Dim y As Integer
Dim I As Integer
Dim Program As String
Dim PO As String
Dim PO_Date As String
Dim Content As String
Dim Deliv_Target_Date As String
Dim Deliv_Date_OTD1 As String
Dim Deliv_Time_OTD1 As String
Dim Last_Reject_Date As String
Dim Deliv_Date_OTD2 As String
Dim Deliv_Time_OTD2 As String
Dim Quality_OQD As String
Dim Quality_NC_Iteration As String
Dim Global_note As String
Dim Deliv_Note_Testia As String
Dim Deliv_Note_AIRBUS As String
Dim Good_Receipt As String
Dim Status As String
Dim Comments As String
Dim Chemin As String
Dim Fichier As String
Dim Method As String
Dim statusBarInitial As Long

Application.Cursor = xlWait ' sablier

'Exécution de la macro "Recuperation_Noms_sous_dossiers"
Call Recuperation_Noms_sous_dossiers

'Permet de ne pas avoir à cliquer sur OK à chaque fois que c'est demandé (msgbox). Ainsi la validation est automatique
Application.EnableEvents = False

nbr = 0

'Recherche du numéro de la dernière ligne non vide en partant de B6 (dernier ID) --> derlig
'Recherche du nombre de références ID en colonne B --> nbr
Derlig = Application.WorksheetFunction.CountA(Range("B:B")) + 3
nbr = Range("B6:B" & Derlig).SpecialCells(xlCellTypeVisible).Count

'Affichage dans une boite de dialogue du nombre de références ID
MsgBox ("You have " & nbr & " ID's references")

'Initialisation des compteurs (on part de la ligne 6)
I = 1
y = 6

'Boucle sur le nombre de références ID, nbr (remplissage du tableau)
statusBarInitial = Application.DisplayStatusBar
Application.DisplayStatusBar = True

While I <= nbr
Application.StatusBar = "Calcul en cours... " & I & " / " & nbr
    DoEvents

'Activation du fichier "FOLLOW_UP_TESTIA.xlsm", on active l'onglet "Feuil1"
Windows("FOLLOW_UP_TESTIA.xlsm").Activate
Sheets("Feuil1").Activate

'x correspond à la valeur de la cellule B6 (première valeur de la liste)
x = Range("B" & y).Value

'Ouverture du fichier "Entry_Form_ID.....xlsm" situé dans le dossier racine auquel on rajoute le sous-dossier ID....
'Activation de l'onglet "ADD_INFOS"
Workbooks.Open Filename:=Dossier_racine & "\" & x & "\" & "Entry_Form_" & x & ".xlsm"
Sheets("ADD_INFOS").Activate

'Mise en mémoire des données du fichier "Entry_Form_ID.....xlsm". Celles-ci sont à rapatrier dans le fichier "FOLLOW_UP_TESTIA.xlsm"
Program = Range("C7").Value
'MsgBox ("Program = ") & Program

PO = Range("C8").Value
'MsgBox ("PO = ") & PO

PO_Date = Range("C9").Value
'MsgBox ("P0_Date = ") & PO_Date

Content = Range("C10").Value
'MsgBox ("Content = ") & Content

Deliv_Target_Date = Range("H6").Value
'MsgBox ("Deliv_Target_Date = ") & Deliv_Target_Date

Deliv_Date_OTD1 = Range("H8").Value
'MsgBox ("Deliv_Date_OTD1 = ") & Deliv_Date_OTD1

Deliv_Time_OTD1 = Range("H9").Value
'MsgBox ("Deliv_Time_OTD1 = ") & Deliv_Time_OTD1

Last_Reject_Date = Range("H11").Value
'MsgBox ("Last_Reject_Date = ") & Last_Reject_Date

Deliv_Date_OTD2 = Range("H13").Value
'MsgBox ("Deliv_Date_OTD2 = ") & Deliv_Date_OTD2

Deliv_Time_OTD2 = Range("H14").Value
'MsgBox ("Deliv_Time_OTD2 = ") & Deliv_Time_OTD2

Quality_OQD = Range("N8").Value
'MsgBox ("Quality_OQD = ") & Quality_OQD

Quality_NC_Iteration = Range("M10").Value
'MsgBox ("Quality_NC_Iteration = ") & Quality_NC_Iteration

Global_note = Range("M12").Value
'MsgBox ("Global_note = ") & Global_note

Deliv_Note_Testia = Range("F21").Value
'MsgBox ("Deliv_Note_Testia = ") & Deliv_Note_Testia

Deliv_Note_AIRBUS = Range("F22").Value
'MsgBox ("Deliv_Note_AIRBUS = ") & Deliv_Note_AIRBUS

Good_Receipt = Range("E30").Value
'MsgBox ("Good_Receipt = ") & Good_Receipt

Status = Range("E31").Value
'MsgBox ("Status = ") & Status

Comments = Range("E32").Value
'MsgBox ("Comments = ") & Comments

Method = Range("C11").Value
'MsgBox ("Method = ") & Method

'On active le fichier "FOLLOW_UP_TESTIA.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TESTIA.xlsm").Activate
Sheets("Feuil1").Activate

'On colle les valeurs précédemment mises en mémoire dans le fichier "FOLLOW_UP_TESTIA.xlsm" (onglet "Feuil1")
Range("C" & y).Value = Program
Range("D" & y).Value = PO
Range("E" & y).Value = PO_Date
Range("F" & y).Value = Content
Range("G" & y).Value = Deliv_Target_Date
Range("I" & y).Value = Deliv_Date_OTD1
Range("J" & y).Value = Deliv_Time_OTD1
Range("L" & y).Value = Quality_OQD
Range("M" & y).Value = Last_Reject_Date
Range("N" & y).Value = Deliv_Date_OTD2
Range("P" & y).Value = Deliv_Time_OTD2
Range("Q" & y).Value = Quality_NC_Iteration
Range("R" & y).Value = Deliv_Note_Testia
Range("S" & y).Value = Deliv_Note_AIRBUS
Range("T" & y).Value = Good_Receipt
Range("U" & y).Value = Status
Range("V" & y).Value = Comments
Range("W" & y).Value = Global_note
Range("X" & y).Value = Method

y = y + 1
I = I + 1

'Fermer le fichier "Entry_Form_ID....xlsm" sans l'enregistrer (false)
Workbooks("Entry_Form_" & x & ".xlsm").Close False

Wend
Application.StatusBar = ""
Application.DisplayStatusBar = statusBarInitial

'On active le fichier "FOLLOW_UP_TESTIA.xlsm" et on se mets dans l'onglet "Feuil1"
Windows("FOLLOW_UP_TESTIA.xlsm").Activate
Sheets("Feuil1").Activate

Range("A1").Select

MsgBox ("Update finished")

Application.EnableEvents = True

'Exécution de la macro "SaveFile"
Call SaveFile

Application.Cursor = xlDefault

End Sub

Sub Macro1()
Dim MaDate As String
MaDate = [H8]
Workbooks.Open(ThisWorkbook.Path & "\sortie.xlsm").Sheets(1).[B6] = MaDate
End Sub

Sub Macro2()
Dim MaDate As Date
MaDate = [H8]
Workbooks.Open(ThisWorkbook.Path & "\sortie.xlsm").Sheets(1).[B6] = MaDate
End Sub