XL 2016 conservation du format de la date

Bonjour,

J'ai un code VBA qui me permet de récupérer des données selon le nom de l'onglet. Là n'est pas le souci.
Le problème c'est que ma source qui contient des données jj/mm/aaaa devient mm/jj/aaaa si jj>12.
Ainsi 11/04/2022 devient 04/11/2022 dans l'onglet récupérateur.
Voici le code :

Option Explicit
Option Base 1
Sub test()
MsgBox Worksheets("dépôt").UsedRange.Address
MsgBox Worksheets("DST.").Tab.ColorIndex
End Sub
Public Sub Unit_Depot()
With Worksheets("dépôt")
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row
DerCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
With .Range(.Cells(1, 1), .Cells(DerLgn, DerCol))
' .Sort Key1:=.Cells(2, 2), Order1:=xlAscending, Header:=xlYes
Tbl_BDD = .Value
End With
End With
Dispache Tbl_BDD
End Sub
Public Function Dispache(ByVal T As Variant)
x = 0 'Ici'
With Worksheets("tous")
.Range("B8:U10000").ClearContents
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
For Lgn = 2 To UBound(T, 1)
x = x + 1
ReDim Preserve TabRecap(UBound(T, 2), x)
For Col = 1 To 12
TabRecap(Col, x) = T(Lgn, Col)
Next
For Col = 13 To 17
TabRecap(1 + Col, x) = T(Lgn, Col)
Next

Next Lgn
.Cells(DerLgn, 2).Resize(UBound(TabRecap, 2), UBound(TabRecap, 1)) = Application.Transpose(TabRecap)
End With
For Each Ws In ThisWorkbook.Worksheets 'pour chaque feuille du Classeur
WsName = Ws.Name

If Ws.Cells(2, 2) = "resp." And Ws.Name <> "tous" Then 'si la couleur de la feuille est Orange
x = 0
Select Case WsName 'cas de la valeur de WsName
Case Is = "Inconnue" 'le Nom de la Feuille est "Inconnue"
StrSearch = "XXX" 'la valeur a rechercher dans la colonne "B" sera "XXX"
Case Else
StrSearch = WsName 'pour les autre Cas on recherche le Nom de la Feuille
End Select
For Lgn = 2 To UBound(T, 1)
If T(Lgn, 1) = StrSearch Then
x = x + 1
ReDim Preserve TabRecap(UBound(T, 2), x)
For Col = 1 To 12
TabRecap(Col, x) = T(Lgn, Col)
Next
For Col = 13 To 17
TabRecap(1 + Col, x) = T(Lgn, Col)
Next
End If
Next Lgn

With Ws
.Range("B8:U10000").ClearContents
If x > 0 Then
DerLgn = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Cells(DerLgn, 2).Resize(UBound(TabRecap, 2), UBound(TabRecap, 1)) = Application.Transpose(TabRecap)

End If
End With
End If
Erase TabRecap
Next Ws
End Function

Pouvez-vous ajouter une ligne qui règlerait le souci SVP ?
Merci beaucoup