Au secours ! Comparer les dates et copier les lignes

Salut,

Voilà un script VBA qui devrait te convenir :

Sub rapport_Parc_Auto()

    Dim wsParc As Worksheet
    Dim wsRapport As Worksheet
    Dim wsTableau As Worksheet
    Dim dateDebut As Date
    Dim dateFin As Date
    Dim lastRow As Long
    Dim lastCol As Long
    Dim i As Long
    Dim ligneDest As Long
    Dim dateParc As Date

    ' Désactivation de l'affichage
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    ' Définition des feuilles
    Set wsParc = ThisWorkbook.Sheets("Parc")
    Set wsRapport = ThisWorkbook.Sheets("Rapport")
    Set wsTableau = ThisWorkbook.Sheets("Tableau_Rapport")

    ' Récupération des dates
    If IsDate(wsTableau.Range("C4").Value) And IsDate(wsTableau.Range("D4").Value) Then
        dateDebut = wsTableau.Range("C4").Value
        dateFin = wsTableau.Range("D4").Value
    Else
        MsgBox "Merci de saisir des dates valides dans les cellules C4 et D4.", vbExclamation
        GoTo Fin
    End If

    ' Vérification de cohérence
    If dateDebut > dateFin Then
        MsgBox "La date de début ne peut pas être postérieure à la date de fin.", vbCritical
        GoTo Fin
    End If

    ' Nettoyage de la feuille Rapport
    wsRapport.Cells.Clear

    ' Trouver la dernière colonne utilisée sur Parc
    lastCol = wsParc.Cells(1, wsParc.Columns.Count).End(xlToLeft).Column

    ' Copier les en-têtes avec mise en forme
    wsParc.Range(wsParc.Cells(1, 1), wsParc.Cells(1, lastCol)).Copy
    wsRapport.Cells(1, 1).PasteSpecial xlPasteAll

    ligneDest = 2
    lastRow = wsParc.Cells(wsParc.Rows.Count, "B").End(xlUp).Row

    ' Copier les lignes correspondantes avec mise en forme
    For i = 2 To lastRow
        If IsDate(wsParc.Cells(i, "B").Value) Then
            dateParc = wsParc.Cells(i, "B").Value
            If dateParc >= dateDebut And dateParc <= dateFin Then
                wsParc.Rows(i).Copy
                wsRapport.Rows(ligneDest).PasteSpecial xlPasteAll
                ligneDest = ligneDest + 1
            End If
        End If
    Next i

    ' Tri automatique par la colonne B (date)
    If ligneDest > 2 Then
        wsRapport.Sort.SortFields.Clear
        wsRapport.Sort.SortFields.Add Key:=wsRapport.Range("B2:B" & ligneDest - 1), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With wsRapport.Sort
            .SetRange wsRapport.Range("A1").CurrentRegion
            .Header = xlYes
            .Apply
        End With
    End If
    
    MsgBox "Rapport généré avec succès entre le " & Format(dateDebut, "dd/mm/yyyy") & _
           " et le " & Format(dateFin, "dd/mm/yyyy") & ".", vbInformation
    
    'Focus sur la feuille Rapport
    wsRapport.Activate
    wsRapport.Range("A1").Select

    ' Réactivation de l'affichage avant le message
    Application.ScreenUpdating = True

    

Fin:
    ' Réactivation de l'affichage
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Bonjour Diablo 76

Franchement Bravo! et merci infiniment. Ta solution répond parfaitement à ma demande. Vous m'avez vraiement débloqué et encore merci !

Cdt

Salut,

Content que ce script puisse répondre à ta demande :-)