XL 2019 Faire un filtre sur deux dates

A-F

XLDnaute Nouveau
Bonjour tout le monde !
J'ai besoins votre aide svp !!

J'ai un fichier (pj) avec plusieurs colonnes de date.
je veux copier certaines colonnes de cette fichier dans un autre en fonction de deux date de début et la date de fin saisis par l'utilisateur.
Je ne sais pas comment je peut faire le filtre sur deux date et faire mon traitement par la suite.
Comme j'ai plusieurs colonne date, il faut tout vérifier at qu'ils soit entre la date de début et la fin.

Je vous joins un extrait de mon code mais je ne suis pas très covécu :-/

Merci d'avance pour votre aide !


VB:
ub Exports_CIN()
    Dim C As Range, Cellule As Range
    Dim nb As Integer, i As Integer, NextRow As Integer, FinalRow As Integer
    Dim Classeur As Workbook
    Dim LaFeuille As Worksheet
    Dim FichierEx As String, Datedebut As String, Datefin As String
    Dim A As Date, B As Date
    
    
    
    'On désactive le presse-papier et le raffraichissement de l'écran
    Application.CutCopyMode = False
    Application.ScreenUpdating = False


    nb = getNbDossier()
  
   'Appler le programme pour creer le fichier export
    FichierEx = ClasseursExport()
    
    'Activer le fichier TDB_PSG.xlsm
    Workbooks("TDB - CCIN.xlsx").Activate

  
    
    FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
  
    Datedebut = InputBox("Entrer la date de debut au format JJ/MM/AAAA")
    Datefin = InputBox("Entrer la date de fin au format JJ/MM/AAAA")
    
    'Copier les donner de chaque ligne/dossier  dans le fichier "fichier_import_A1":
    
    
    For Each Cellule In Workbooks("TDB - CCIN.xlsx").Worksheets("TDB - Type").Range("AR5:GD5")
    
        If Cellule.Value = "actCreationDate" Then
       


                        For i = 6 To nb + 5 'parcourir chaque ligne en comencant par ligne 6
                        
                          
                                      If Cellule.Value >= Datedebut And Cellule.Value <= DateFinThen
                                        
                                    
                                    
                                         For Each C In Workbooks("TDB - CCIN.xlsx").Worksheets("TDB - Type").Range("AS" & i & ":DV" & i) 'la palage de Acte A01
                                            
                                        
                                             If C.Value = "A01" Then ' si la valeure de cellule = A01
                                              
                                                'Activer le fichier export
                                                Workbooks("fichier_import_A1.xlsx").Activate
                                                        
                                            
                                                         Workbooks("TDB - CCIN.xlsx").Worksheets("TDB - Type").Range("E" & i).Copy 'UserEmail
                                        
                                                        'Trouver la dernier ligne
                                                        Workbooks("fichier_import_A1.xlsx").Activate
                                                        NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
                                                        
                                                        
                                                        'Paste
                                                        Cells(NextRow, 1).Select
                                                        ActiveCell.PasteSpecial Paste:=xlPasteValues
                                                    
                                               End If
            End If
        End If
      End If
    Next
 

Pièces jointes

  • TDB_PSG_B.xlsm
    112.3 KB · Affichages: 16

Discussions similaires

Statistiques des forums

Discussions
311 734
Messages
2 082 020
Membres
101 872
dernier inscrit
Colin T