Comparaison de date

Bonjour à tous,

Débutant en VBA, j'aimerais solliciter votre aide pour résoudre un petit problème de programmation.

J'ai un fichier Excel avec un onglet appelé "Onglet0" et dans lequel il y a un tableau se présentant de la sorte :

|A:nom| |B|..........|E:Date de sortie|

XXXXX ##/##/####

YYYYY ##/##/####

ZZZZZ ##/##/####

Dans la colonne E il y a soit des dates soit des vides.

En colonne E, lorsqu'il y a une date de sortie, j'aimerais la comparer avec la date du jour et copier la ligne entière dans un onglet appelé "Onglet1" SI la date indiquée est postérieure à la date du jour.

S'il n'y a pas de date ou qu'elle est antérieure à la date d'aujourd'hui, la macro devrait copier la ligne entière et la copier dans dans un onglet appelé "Onglet2".

Pourriez vous m'aider s'il vous plait?

En vous remerciant d'avance.

Bonjour,

Tu sembles face à un cas très classique d'archivage de données ...

La seule question à éclaircir c'est que tu parles de "copier" ... cela signifie-t-il que la ligne d'origine demeure sur le premier onglet ?

Oui la ligne d'origine reste sur le premier onglet mais lorsque la date présente dans cette ligne répond à certaine condition, elle est copier soit dans l'onglet 1 soit dans l'onglet 2.

Ai-je répondu à ta question James007?

Y a-t-il également possibilité de comparer une date que l'on pourrait saisir dans une messageBox à la place de la date du jour ?

Merci

Bonjour,

Ci-dessous, un premier test de code à adapter ...

Sub CopieLigne()
Dim lrow As Integer
Dim lcop As Integer
Dim i As Integer
Dim smes As String
Dim dref As Date

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lrow = Worksheets("Onglet0").Cells(Cells.Rows.Count, "A").End(xlUp).row

  smes = Application.InputBox("Merci de saisir la Date de Référence")
  If IsDate(smes) Then
      dref = DateValue(smes)
  Else
      MsgBox "Date Non Valable"
  End If

For i = lrow To 2 Step -1
    lcop = Worksheets("Onglet1").Cells(Cells.Rows.Count, "A").End(xlUp).row + 1
    If Worksheets("Onglet0").Cells(i, 5).Value <= dref And IsEmpty(Worksheets("Onglet0").Cells(i, 6)) Then
        Worksheets("Onglet0").Cells(i, 5).EntireRow.Copy Destination:=Worksheets("Onglet1").Cells(lcop, 1)
        Worksheets("Onglet0").Cells(i, 6).Value = "Copie"
    End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Il faut s'assurer que les deux onglets contiennent bien les mêmes entêtes sur la première ligne ...

Rebonjour,

Merci, ton code fonctionne très bien! je l'ai adapté comme suit pour avoir :

• dans l'onglet 1 : les lignes dont les dates sont postérieures ou égales à la date saisie,
• dans l'onglet 2 : les lignes dont les dates sont antérieures à la date saisie.

Sub CopieLigne()
Dim lrow As Integer
Dim lcop As Integer
Dim i As Integer
Dim smes As String
Dim dref As Date

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
lrow = Worksheets("Onglet0").Cells(Cells.Rows.Count, "A").End(xlUp).Row

  smes = Application.InputBox("Merci de saisir la Date de Référence")
  If IsDate(smes) Then
      dref = DateValue(smes)
  Else
      MsgBox "Date Non Valable"
  End If

For i = lrow To 2 Step -1
    lcop = Worksheets("Onglet1").Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1

    If Worksheets("Onglet0").Cells(i, 5).Value >= dref And IsEmpty(Worksheets("Onglet0").Cells(i, 6)) Then
        Worksheets("Onglet0").Cells(i, 5).EntireRow.Copy Destination:=Worksheets("Onglet1").Cells(lcop, 1)
        Worksheets("Onglet0").Cells(i, 6).Value = "Copie1"

    ElseIf Worksheets("Onglet0").Cells(i, 5).Value < dref And IsEmpty(Worksheets("Onglet0").Cells(i, 6)) Then
        Worksheets("Onglet0").Cells(i, 5).EntireRow.Copy Destination:=Worksheets("Onglet2").Cells(lcop, 1)
        Worksheets("Onglet0").Cells(i, 6).Value = "Copie2"

    End If
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Le seul problème est que dans l'onglet 2, les lignes ne se copient qu'à partir de la ligne 3 en laissant la ligne 2 vide. Saurais-tu pourquoi?

Bonjour,

Content que tu aies pu franchir une première étape ...

Sans ton fichier sous les yeux, je vais avoir du mal à faire des tests ... il faudrait avant tout vérifier que la cellule A2 de l'onglet de destination est totalement vide ...

Je te joins le fichier en question. La cellule A2 de l'onglet Onglet2 est bien vide.

Re,

Ci-joint ton fichier avec le code ajusté ...

Merci James007 ! ça m'a vraiment bien aidé !!

BarneyYagami a écrit :

Merci James007 ! ça m'a vraiment bien aidé !!

De rien ...

Merci beaucoup pour tes remerciements ...