Importer si la date est antérieure à 48H et n'existe pas dans destination

Bonjour,

J'aimerais pouvoir importer des données seulement si elles respectent ces deux conditions :

• Que la date soit antérieure à 48H (2 jours)
• Que l'ID unique ne soit pas déjà présent dans la destination.

Ci-dessous le code qui me sert à ouvrir le classeur et copier-coller les données :

Sub OuvrirFichierSource()

    Dim objOuvrir As FileDialog
    Dim objFichiers As FileDialogSelectedItems
    Dim wbsource As Workbook, wbdest As Workbook

    Set objOuvrir = Application.FileDialog(msoFileDialogOpen)
    'Affiche la fenêtre "Ouvrir"
    With objOuvrir
        'Effacer les filtres existants.
        .Filters.Clear
        'Définition du Type de fichiers (extension)à ouvrir.
        .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm; *.csv"
        .Show
        'Définit le ou les fichiers sélectionnées
        Set objFichiers = .SelectedItems
    End With

    'si aucun fichier n'a été sélectionné on annule
    If Not objFichiers.Count = 1 Then Exit Sub

    Application.ScreenUpdating = False

    'configuration du classeur de destination et du classeur source
    Set wbdest = ThisWorkbook
    Set wbsource = Workbooks.Open(objFichiers(1))

    'Configuration des feuilles d'origine et source

    Dim wfDest As Worksheet
    Set wfDest = wbdest.Sheets("Lst_Clean")
    Dim wfSource As Worksheet
    Set wfSource = wbsource.Sheets("Lst_Source")

    'Configuration des cellules d'origine et de destination

    Const cellSource = "A2"
    Const cellDest = "A2"

    'Configuration des plages sources et destination
    Set plageSource = wfSource.Range(cellSource)
    Set PlageDest = wfDest.Range(cellDest)

    'Selection de la plages source a copier
    plageSource.Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    'Coller la plage dans la destination
    PlageDest.PasteSpecial xlPasteValues
    Application.CutCopyMode = False

    wbsource.Close SaveChanges:=False
    Application.ScreenUpdating = True
    MsgBox ("Import terminé")
End Sub

La structure du tableau source et de destination :

Les colonnes qui doivent me servir de préfiltre sont la première "A" (date) et la troisième "D" (ID), le tableau "réel" contient plus de 150 colonnes et autant de lignes. J'imagine que je dois mettre une boucle qui compare les ID source et destination et si l'id n'existe pas dans la destination, une autre boucle doit comparer la date du jour avec celle du tableau source et copier uniquement la ligne que si la date est antérieure à 48h soit deux jours.

Mon premier problème c'est la comparaison de date que je n'arrive pas a faire fonctionner correctement, le résultat est sous forme :

Mon code de test ci dessous :

Sub compDates()

    Dim i As Integer
Derligne = Sheets("Sources").Range("A2").End(xlDown).Row
    For i = 2 To Derligne
        Sheets("Feuil6").Range("A" & i) = DateDiff("D", Sheets("Sources").Range("A" & i), Sheets("Dest").Range("B39" & i))
    Next i

End Sub

Bonjour,

Pour te guider un peu dans la logique ... Il faut que tu boucles sur les ID. Si l'ID de la ligne traitée n'est pas trouvé, alors on regarde si la date est antérieure à 2 jours. Si elle l'est, alors tu récupères les infos. Sinon, tu passes à la suite.

J'imagine que le 1er code a été fait par quelqu'un d'autre (voire ChatGPT ?) et que tu as essayé de faire le 2ème code ?

Bonjour,

C'est un mix de code récupéré à droite à gauche et que j'ai adapté à mes besoins.

Bonjour Hean, le forum,

Hello 21Formatic

Peux-tu joindre un fichier pour voir comment sont structurées tes données ?

Cordialement,

Bonjour,

ci-dessous un fichier d'exemple sachant que chaque onglet correspond a un classeur excel dans ce que je souhaite faire à la fin.

Re,

Un essai...à tout hasard...car pas certain d'avoir compris la demande...

Dans un module du classeur de destination:

Sub OuvrirFichierSource()
 Dim k%, i%, x%
 Dim dateref As Date
 Dim tb, ntb()
 Dim objOuvrir As FileDialog, objFichiers As FileDialogSelectedItems
 Dim wbsource As Workbook, wbdest As Workbook
 Dim wfDest As Worksheet, wfSource As Worksheet

  Application.ScreenUpdating = False

    Set objOuvrir = Application.FileDialog(msoFileDialogOpen)
    'Affiche la fenêtre "Ouvrir"
     With objOuvrir
      'Effacer les filtres existants.
       .Filters.Clear
       'Définition du Type de fichiers (extension)à ouvrir.
       .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm; *.csv"
       .Show
       'Définit le ou les fichiers sélectionnées
      Set objFichiers = .SelectedItems
     End With

     'si aucun fichier n'a été sélectionné on quitte la procédure
     If Not objFichiers.Count = 1 Then Exit Sub

    'configuration du classeur de destination et du classeur source
    Set wbdest = ThisWorkbook
    Set wfDest = wbdest.Sheets("Lst_Clean") 'feuille de destination
    Set wbsource = Workbooks.Open(objFichiers(1))

    'Configuration des feuilles  source = date de référence
     Set wfSource = wbsource.Sheets("Lst_Source")
               tb = wfSource.Range("A1").CurrentRegion 'tableau de valeurs de la feuille source
          dateref = DateAdd("d", -2, Date) 'date du jour - 2 jours

    'redimensionnement et alimentation du tableau de données ntb
     k = 0 'indice de départ
     ReDim ntb(1 To UBound(tb, 1), 1 To UBound(tb, 2))
      For i = 2 To UBound(tb, 1) 'boucle sur les lignes du tableau de valeur
       'si l'ID (colonne 4) n'est pas présent sur la feuille de destination (fonction NB.SI)
       If Application.WorksheetFunction.CountIf(wfDest.Columns(4), tb(i, 4)) = 0 Then
        If CDate(tb(i, 1)) = dateref Then 'si la date = dateref
         For x = 1 To UBound(tb, 2) 'boucle sur les colonnes
          ntb(k + 1, x) = tb(i, x) 'retranscrit les données
         Next x ' colonne suivante
         k = k + 1 'incrémente l'indice
        End If 'fin condition date
       End If 'fin condition ID
      Next i 'ligne suivante

    'si le tableau comprend des données,
    'on les écrit sur la feuille de destination à partir de la dernière ligne
    If k > 0 Then
     With wfDest 'agi sur la feuille de destination
      'écrit les données du tableau NTB à partir de la dernière ligne en colonne A
      .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Resize(k, UBound(tb, 2)) = ntb
      Erase tb: Erase ntb 'libère la mémoire
     End With
    End If

    wbsource.Close SaveChanges:=False
    Application.ScreenUpdating = True
    MsgBox "Import terminé", vbInformation
End Sub

Cordialement,

Re,

Merci pour t'ont travail effectué, ça fonctionne, mais seulement sur les dates à J -2.

En gros mon souhait, c'est si l'ID de la ligne "fichier source" est inexistant dans la destination et que la date " est supérieure ou égale date -2 " on l'importe sur le fichier de destination

Re,

J'ai réussi à trouver l'endroit où je devais faire la modification pour avoir le résultat voulu.

Du coup, je vais l'adapter au vrai fichier, merci à vous tous pour votre aide !

Re,

Merci pour le retour,

Effectivement, c'est bien cette ligne qu'il faut modifier:

 If CDate(tb(i, 1)) <= dateref Then 'si la date <= dateref

Si ton problème est résolu, pense à clôturer le fil,

Bonne continuation,

Cordialement,

Merci encore , c'est du temps et du travail qui mérite d'être salué