XL 2016 conservation du format de la date

[eastwick]

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

 

[xUpsilon]

Bonjour,

Pense à utiliser le bouton "</>" pour insérer du code plus proprement.
Je ne sais pas où se trouve la date dans ton code, mais 2 possibilités :
- si ce n'est que du format, il te suffit de l'adapter avec un format date en jj/mm/aaaa après insertion de la date sur le fichier Excel
- si la date s'en trouve modifiée, tu peux forcer la compréhension de la date en utilisant Worksheetfunction.DateSerial

Bonne journée,

 

[eastwick]

Merci

 

[Dranreb]

Bonjour
DateSerial n'existe pas dans Excel.WorksheetFunction. C'est une fonction de la bibliothèque VBA renvoyant une date d'après A, M, J. Il y existe aussi Date, valant la date du jour.