Tableau VBA / Erreur d'exécution 5 argument ou appel de procédure incorrect

Bonjour au forum,

Dans un fichier concernant des dons de sang, j'effectue une importation des données depuis un fichier texte et je cherche à compléter deux colonnes supplémentaires à partir de cet import :

- la 1ere me permettant de savoir si l'individu à +de 65 ans ou moins de 65 ans à partir de sa date de naissance (date de naissance en colonne G, résultat à renseigner en colonne J)

- la 2nde me permettant de connaitre le jour de la semaine du don (date du don en colonne A, résultat à renseigner en colonne K)

Je rencontre une erreur d'exécution 5 argument ou appel de procédure incorrect sur la partie de création d'un tableau pour traiter ces données.

Voici le code complet d'importation des données :

Sub Copy()

Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (Cellule de DESTInation)
Dim dl1 As Long 'déclare la variable dl1 (Dernière ligne non vide)
Dim dl2 As Long 'déclare la variable dl2 (Dernière ligne non vide)
Dim Suppr As String 'déclare la variable Suppr (Fichier à supprimer)

'-----------------------------------------------------------------------------------------------------------------------
If MsgBox("Veuillez sélectionner le fichier d'extraction Inlog au format .txt des données brutes à importer." _
    & Chr(10) & "Ce fichier se trouve dans le dossier : P:\ctsshare\Bureautique\Extraction\" _
    , vbInformation + vbOKCancel, "Importation des données") = vbCancel Then
    Exit Sub
Else:
'-----------------------------------------------------------------------------------------------------------------------
    Set CD = ThisWorkbook 'définit le classeur destination CD
    Set OD = CD.Worksheets("Import") 'définit l'onglet destination OD
    CA = "P:\ctsshare\Bureautique\Extraction\" 'définit le chemin d'accès CA
    '-----------------------------------------------------------------------------------------------------------------------
    With Application.FileDialog(msoFileDialogOpen) 'prend en compte la boîte de dialogue d'ouverture de fichiers
        .AllowMultiSelect = True 'n'autorise qu'un seul fichier
        .Filters.Add "Fichier TXT", "*.txt" 'définit le filtre sur le type de fichiers
        .InitialFileName = CA 'définit le dossier par défaut à l'ouverture de la boîte de dialogue
        .Show 'affiche la boîte de dialogue
        If .SelectedItems.Count = 1 Then .Execute 'si un élément est sélectionné, valide la boîte de dialogue
    End With 'fin de la prise en compte de la boîte de dialogue d'ouverture de fichiers
    '-----------------------------------------------------------------------------------------------------------------------
    Set CS = ActiveWorkbook 'définit le classeur source CS
    Set OS = CS.Worksheets(1) 'définit l'onglet source OS
    '-----------------------------------------------------------------------------------------------------------------------
    Application.ScreenUpdating = False
        Set DEST = IIf(OD.Range("A11").Value = "", OD.Range("A11"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST (A11 si A11 est vide, sinon la première cellule vide de la colonne A de l'onlet destination OD)
        dl1 = OS.Range("A" & Rows.Count).End(xlUp).Row
        '-----------------------------------------------------------------------------------------------------------------------
        OD.Unprotect "mdp"
        OS.Range("B2:J" & dl1).Copy DEST 'OS.UsedRange.Copy DEST 'copie l'ensemble des cellules éditées de l'onglet source dans DEST
        CS.Close False 'ferme le fichier source sans enregistrer
        '-----------------------------------------------------------------------------------------------------------------------
            With OD
                dl2 = OD.Range("A" & Rows.Count).End(xlUp).Row
                Dim ta(), tb()
                Dim td
                Dim tm

                ReDim ta(1 To dl2 - 10, 1 To 1), tb(1 To dl2 - 10, 1 To 1)
                td = Range("A11:A" & dl2).Value 'K11.offset(0,-10)
                tm = Range("G11:G" & dl2).Value 'J11.offset(0,-3)

                For i = LBound(td) To UBound(td)
                    ta(i, 1) = Format(td(i, 1), "dddd")
                    Mid(ta(i, 1), 1, 1) = UCase(Left(ta(i, 1), 1))
                    If DateDiff("yyyy", tm(i, 1), Now, vbMonday) < 65 Then tb(i, 1) = "< 65 ans" Else tb(i, 1) = ">= 65 ans"
                Next i

                Range("K11:K" & dl2).Value = ta
                Range("J11:J" & dl2).Value = tb
            End With
        '-----------------------------------------------------------------------------------------------------------------------
        'Call ExtractMonth
        Call NettoyerPressPapiers
        Call NettoyerCacheTablePivot
        Call ActualiserTCDs
        '-----------------------------------------------------------------------------------------------------------------------
        Suppr = Dir("P:\ctsshare\Bureautique\Extraction\*.*")
        Do While Suppr <> ""
            Kill "P:\ctsshare\Bureautique\" & Suppr
            Suppr = Dir
        Loop
    '----------------------------------------------------------------
    Application.ScreenUpdating = True
    MsgBox "L'import a été effectué avec succès !", vbInformation, "Importation réussie !"
    Call FilterPivotTableCE
    Sheets("Tableau de bord").Activate
End If
Exit Sub 'Permet de sortir de la procédure et évite la gestion d'erreur (Erreur), si la macro s'est déroulée sans encombre.
'-----------------------------------------------------------------------------------------------------------------------
Erreur:
MsgBox "Une erreur est survenue." & vbCrLf & "Le fichier va se fermer automatiquement sans être sauvegardé." & vbCrLf & _
"Si l'erreur persiste, merci de me contacter par e-mail en joignant, si possible, une capture d'écran de ce message." & vbCrLf & _
vbCrLf & "Ligne n° : " & Erl() & vbLf & "N° d'erreur : " & Err.Number & vbLf & "Description :" & Err.Description & vbCrLf & vbCrLf & "nom.nom@mail.com", _
vbExclamation, "Annulation !"
Exit Sub 'Permet de sortir de la procédure et évite la gestion d'erreur (Erreur), si la macro
's'est déroulée sans encombre.
'calcul & mise en forme des durées des étapes
'-----------------------------------------------------------------------------------------------------------------------
End Sub

Il m'est malheureusement très compliqué de fournir un fichier exemple, j'espère que ce sera suffisant sans...

Merci d'avance pour l'aide !

bonjour,

à vérifier

 With OD
                dl2 = .Range("A" & Rows.Count).End(xlUp).Row
                Dim ta(), tb()
                Dim td
                Dim tm

                ReDim ta(1 To dl2 - 10, 1 To 1), tb(1 To dl2 - 10, 1 To 1)
                td = .Range("A11:A" & dl2).Value 'K11.offset(0,-10)
                tm = .Range("G11:G" & dl2).Value 'J11.offset(0,-3)

                For i = LBound(td) To UBound(td)
                    ta(i, 1) = Format(td(i, 1), "dddd")
                    Mid(ta(i, 1), 1, 1) = UCase(Left(ta(i, 1), 1))
                    If DateDiff("yyyy", tm(i, 1), Now) < 65 Then tb(i, 1) = "< 65 ans" Else tb(i, 1) = ">= 65 ans"
                Next i

                .Range("K11:K" & dl2).Value = ta
                .Range("J11:J" & dl2).Value = tb
            End With

mauvais paramètres datediff, et problème potentiel dans l'adressage des cellules, manque le point dans les instructions range() pour faire référence à l'objet déclaré avec with.

Bonjour h2so4,

Merci infiniment pour ta réponse, c'est parfait.

Tu me sauves une fois de plus...

Excellente journée à toi et au forum !