Date format US après copie

Bonjour,

Je m'y connais peu en VBA, et je viens de reprendre un projet professionnel qui consiste à créer plusieurs pages en fonction d'une date.
Si la date de la ligne est entre 0 à 20 jours avec la date d'aujourd'hui, première page, si entre 21 à 25 jours, deuxième page etc.

Cela fonctionne bien, mais je rencontre un problème lorsque le VBA copie la ligne dans une autre page, les colonnes dates deviennent des dates aux formats US si la conversion est possible.
Par exemple, le 12/05/2025 devient le 05/12/2025. Par contre le 24/01/2025 reste comme tel car 01/24/2025 est impossible.

Mes paramètres régionaux sont bien au format FR.

Avez-vous une solution pour forcer le format dd/mm/aaaa après la copie que fait VBA?

En vous remerciant par avance https://forum.excel-pratique.com/template/img/emojis/1f600.svg)">

Sub TraiterEtClassifier()
    Dim wsImport As Worksheet, wsAccueil As Worksheet
    Dim wsErreur As Worksheet, wsMiTemps As Worksheet
    Dim dictFeuilles As Object, dictLibelles As Object
    Dim dictNormales As Object, dictNonRecues As Object
    Dim ligne As Long, joursDiff As Long
    Dim dateDJT As Variant, dateAC As Variant, dateAJ As Variant
    Dim dateReference As Date, nomFeuille As Variant, entete As Variant
    Dim colDateDJT As Long, colDateAC As Long, colDateAJ As Long
    Dim colPRN1 As Long, colPRN2 As Long
    Dim colMiTemps1 As Long, colMiTemps2 As Long
    Dim miTempsCount As Long: miTempsCount = 0
    Set wsImport = ThisWorkbook.Sheets("Import")
    Set wsAccueil = ThisWorkbook.Sheets("Accueil")
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    entete = wsImport.Rows(1).Value

    ' Recherche dynamique des colonnes
    Dim i As Long, lastCol As Long
    lastCol = wsImport.Cells(1, wsImport.Columns.Count).End(xlToLeft).Column
    For i = 1 To lastCol
        Select Case Trim(UCase(wsImport.Cells(1, i).Value))
            Case "DATE_DJT": colDateDJT = i
            Case "DATE DÉBUT ARRÊT 1", "DATE DEBUT ARRET 1": colDateAC = i
            Case "DATE DÉBUT ARRÊT 2", "DATE DEBUT ARRET 2": colDateAJ = i
            Case "DATE DÉBUT PRN 1", "DATE DEBUT PRN 1": colPRN1 = i
            Case "DATE DÉBUT PRN 2", "DATE DEBUT PRN 2": colPRN2 = i
            Case "DATE DÉBUT PRN HISTO", "DATE DEBUT PRN HISTO": colPRNHisto = i
            Case "DATE DÉBUT ARRÊT HISTO", "DATE DEBUT ARRET HISTO": colArretHisto = i
            Case "MI-TEMPS SALAIRE 1": colMiTemps1 = i
            Case "MI-TEMPS SALAIRE 2": colMiTemps2 = i
        End Select
    Next i

    ' Dictionnaires
    Set dictFeuilles = CreateObject("Scripting.Dictionary")
    Set dictLibelles = CreateObject("Scripting.Dictionary")
    Set dictNormales = CreateObject("Scripting.Dictionary")
    Set dictNonRecues = CreateObject("Scripting.Dictionary")
    dictFeuilles.Add "Jours_0_20", Nothing: dictLibelles.Add "Jours_0_20", "<= 20 jours"
    dictFeuilles.Add "Jours_21_25", Nothing: dictLibelles.Add "Jours_21_25", "21 à 25 jours"
    dictFeuilles.Add "Jours_26_29", Nothing: dictLibelles.Add "Jours_26_29", "26 à 29 jours"
    dictFeuilles.Add "Jours_30_39", Nothing: dictLibelles.Add "Jours_30_39", "30 à 39 jours"
    dictFeuilles.Add "Jours_40_plus", Nothing: dictLibelles.Add "Jours_40_plus", ">= 40 jours"
    For Each nomFeuille In dictFeuilles.Keys
        Set dictNormales(nomFeuille) = CreateObject("System.Collections.ArrayList")
        Set dictNonRecues(nomFeuille) = CreateObject("System.Collections.ArrayList")
    Next

    ' Nettoyage / création des feuilles
    Dim key As Variant
    For Each key In dictFeuilles.Keys
        On Error Resume Next
        Set dictFeuilles(key) = ThisWorkbook.Sheets(key)
        If dictFeuilles(key) Is Nothing Then
            Set dictFeuilles(key) = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
            dictFeuilles(key).Name = key
        End If
        On Error GoTo 0
        With dictFeuilles(key)
            .Cells.ClearContents
            .Rows(1).Value = entete
        End With
    Next key

    ' Feuille Erreur
    On Error Resume Next
    Set wsErreur = ThisWorkbook.Sheets("Erreur")
    If wsErreur Is Nothing Then
        Set wsErreur = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsErreur.Name = "Erreur"
    End If
    On Error GoTo 0
    wsErreur.Cells.ClearContents
    wsErreur.Rows(1).Value = entete

    ' Feuille Mi-temps
    On Error Resume Next
    Set wsMiTemps = ThisWorkbook.Sheets("Mi-temps")
    If wsMiTemps Is Nothing Then
        Set wsMiTemps = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsMiTemps.Name = "Mi-temps"
    End If
    On Error GoTo 0
    wsMiTemps.Cells.ClearContents
    wsMiTemps.Rows(1).Value = entete

    ' Traitement
    ligne = 2
    Do While wsImport.Cells(ligne, 1).Value <> ""
        dateDJT = wsImport.Cells(ligne, colDateDJT).Value
        dateAC = wsImport.Cells(ligne, colDateAC).Value
        dateAJ = wsImport.Cells(ligne, colDateAJ).Value

        ' Mi-temps
        If wsImport.Cells(ligne, colMiTemps1).Value = "O" Or wsImport.Cells(ligne, colMiTemps2).Value = "O" Then
            wsMiTemps.Rows(wsMiTemps.Cells(wsMiTemps.Rows.Count, 1).End(xlUp).Row + 1).Value = wsImport.Rows(ligne).Value
            miTempsCount = miTempsCount + 1
        ElseIf Not IsDate(dateDJT) Then
            wsErreur.Rows(wsErreur.Cells(wsErreur.Rows.Count, 1).End(xlUp).Row + 1).Value = wsImport.Rows(ligne).Value
        Else
            dateReference = CDate(dateDJT) + 1
            joursDiff = Date - dateReference
            Select Case True
                Case joursDiff <= 20: nomFeuille = "Jours_0_20"
                Case joursDiff <= 25: nomFeuille = "Jours_21_25"
                Case joursDiff <= 29: nomFeuille = "Jours_26_29"
                Case joursDiff <= 39: nomFeuille = "Jours_30_39"
                Case Else: nomFeuille = "Jours_40_plus"
            End Select

            Dim receptionOK As Boolean
            receptionOK = False
            Dim datesReception() As Variant
            datesReception = Array( _
                dateAC, _
                dateAJ, _
                wsImport.Cells(ligne, colPRN1).Value, _
                wsImport.Cells(ligne, colPRN2).Value, _
                wsImport.Cells(ligne, colPRNHisto).Value, _
                wsImport.Cells(ligne, colArretHisto).Value _
            )

            Dim d As Variant
            For Each d In datesReception
                If IsDate(d) Then
                    If Abs(CDate(d) - CDate(dateDJT)) <= 3 Then
                        receptionOK = True
                        Exit For
                    End If
                End If
            Next d

            If receptionOK Then
                dictNormales(nomFeuille).Add wsImport.Rows(ligne).Value
            Else
                dictNonRecues(nomFeuille).Add wsImport.Rows(ligne).Value
            End If
        End If
        ligne = ligne + 1
    Loop

    ' Écriture des résultats
    Dim feuille As Worksheet, rowIndex As Long, item As Variant
    For Each key In dictFeuilles.Keys
        Set feuille = dictFeuilles(key)
        rowIndex = 2
        For Each item In dictNormales(key)
            feuille.Rows(rowIndex).Value = item
            rowIndex = rowIndex + 1
        Next item

        If dictNonRecues(key).Count > 0 Then
            rowIndex = rowIndex + 4
            feuille.Cells(rowIndex, 1).Value = "PRN potentiellement ABS"
            feuille.Cells(rowIndex, 1).Font.Bold = True
            feuille.Cells(rowIndex, 1).HorizontalAlignment = xlCenter
            feuille.Cells(rowIndex, 1).Interior.Color = RGB(238, 130, 238)
            rowIndex = rowIndex + 1
            For Each item In dictNonRecues(key)
                feuille.Rows(rowIndex).Value = item
                feuille.Rows(rowIndex).Interior.Color = RGB(169, 169, 169)
                rowIndex = rowIndex + 1
            Next item
        End If
    Next key

    ' Récapitulatif Accueil
    i = 4
    For Each key In dictFeuilles.Keys
        wsAccueil.Cells(i, 1).Value = dictLibelles(key)
        wsAccueil.Cells(i, 2).Value = dictNormales(key).Count
        wsAccueil.Cells(i, 3).Value = dictNonRecues(key).Count
        i = i + 1
    Next key

    wsAccueil.Cells(9, 1).Value = "Mi-temps"
    wsAccueil.Cells(9, 2).Value = miTempsCount

    ' Ajustement colonnes + Alignement à gauche + format D & F
    For Each feuille In ThisWorkbook.Sheets
        If feuille.Name = "Import" Or feuille.Name = "Erreur" Or _
           feuille.Name = "Mi-temps" Or dictFeuilles.Exists(feuille.Name) Then
            With feuille.Cells
                .EntireColumn.AutoFit
                .HorizontalAlignment = xlLeft
            End With
            feuille.Columns(4).NumberFormat = "# ##0"
            feuille.Columns(6).NumberFormat = "# ##0"
            With feuille.Rows(1)
                .Font.Bold = True
                .Interior.Color = RGB(173, 216, 230)
            End With
        End If
    Next feuille

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Traitement et classement terminés !", vbInformation
End Sub

Bonjour & bienvenue,

Je pense que le problème vient du fait que vous utilisez CDate. Cette fonction a tendance à interpréter les dates textuelles comme dates US. Vous pourriez utiliser DateValue qui en théorie utilise le format local. Personnellement, je préfère utiliser DateSerial avec Year/Month/Day pour m'assurer que les dates sont interprétées correctement. C'est un peu plus long mais si vous l'encapsulez dans une petite function vous n'avez plus à vous en préoccuper.

Bonjour Saboh, merci beaucoup pour ton message.

CDate était utilisé pour comparer les dates, je viens de suivre ton conseil afin que la comparaison se fasse au bon format.
Pour expliquer ce qu'il se passe :

Analyse de la ligne dans la feuille Import

For ligne = 2 To derniereLigne
    valeurDateDJT = Trim(wsImport.Cells(ligne, colDJT).Value)

    If IsDate(valeurDateDJT) Then
        dateDJT = DateValue(valeurDateDJT) + 1 
        nbJours = Date - dateDJT

Attribution d'une catégorie de jours

If nbJours < 0 Then
    nomFeuille = "Jours_1"
ElseIf nbJours <= 5 Then
    nomFeuille = "Jours_2"
ElseIf nbJours <= 15 Then
    nomFeuille = "Jours_3"
ElseIf nbJours <= 30 Then
    nomFeuille = "Jours_4"
Else
    nomFeuille = "Jours_5"
End If

Ajout de la ligne dans le dictionnaire

dictNormales(nomFeuille).Add wsImport.Rows(ligne).Value

Écriture dans la bonne page

For Each nomFeuille In dictNormales.Keys
    Set wsCible = ThisWorkbook.Sheets(nomFeuille)
    ligneCible = 2

    ' Recopie de l'en-tête
    wsCible.Rows(1).Value = wsImport.Rows(1).Value

    ' Collage des lignes
    For Each ligneValeur In dictNormales(nomFeuille)
        wsCible.Cells(ligneCible, 1).Resize(1, UBound(ligneValeur, 2)).Value = ligneValeur
        ligneCible = ligneCible + 1
    Next ligneValeur
Next nomFeuille

Je n'arrive pas à comprendre à quelle moment je me suis trompé pour cette histoire de format de date... :(

Merci pour votre temps!