XL 2019 Déplacer lignes selon contenu d'une cellule

[clemcoad]

Bonjour à tous !
Je cherche à déplacer une ligne sur une autre feuille en fonction du contenu d'une cellule. Cependant, j'aimerai que ce soit selon une date. C'est-à-dire, n'importe qu'elle date saisie dans telle colonne, la ligne correspondante est copiée/déplacée dans une autre feuille. J'ai déjà ce bout de code qui me permet de déplacer la ligne dans une autre feuille selon une valeur fixe :
Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Planning integration").UsedRange.Rows.Count
J = Worksheets("test").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("test").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Planning integration").Range("F1:F" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "ok" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("test").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

En vert la partie que j'aimerai changer pour que ce soit en fonction d'une date (n'importe laquelle) plutôt qu'une valeur constante.
Merci d'avance ! Bonne journée !

 

[Gégé-45550]

Bonjour à tous !
Je cherche à déplacer une ligne sur une autre feuille en fonction du contenu d'une cellule. Cependant, j'aimerai que ce soit selon une date. C'est-à-dire, n'importe qu'elle date saisie dans telle colonne, la ligne correspondante est copiée/déplacée dans une autre feuille. J'ai déjà ce bout de code qui me permet de déplacer la ligne dans une autre feuille selon une valeur fixe :
Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Planning integration").UsedRange.Rows.Count
J = Worksheets("test").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("test").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Planning integration").Range("F1:F" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "ok" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("test").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

En vert la partie que j'aimerai changer pour que ce soit en fonction d'une date (n'importe laquelle) plutôt qu'une valeur constante.
Merci d'avance ! Bonne journée !

Bonjour,
Essayez de remplacer

If CStr(xRg(K).Value) = "ok" Then

par

If IsDate((xRg(K)) Then

Cordialement,

 

[ARMAEL]

Pour déplacer la ligne en fonction d'une date plutôt qu'une valeur constante, vous pouvez remplacer la condition "If CStr(xRg(K).Value) = "ok" Then" par une condition vérifiant si la valeur de la colonne contenant la date est une date valide à l'aide de la fonction "IsDate". Voici le code mis à jour :
Sub MoveRowBasedOnDateValue() 'Updated by ChatGPT on 2023/04/19 Dim xRg As Range Dim xCell As Range Dim i As Long Dim J As Long Dim K As Long i = Worksheets("Planning integration").UsedRange.Rows.Count J = Worksheets("test").UsedRange.Rows.Count If J = 1 Then If Application.WorksheetFunction.CountA(Worksheets("test").UsedRange) = 0 Then J = 0 End If Set xRg = Worksheets("Planning integration").Range("F1:F" & i) On Error Resume Next Application.ScreenUpdating = False For K = 1 To xRg.Count If IsDate(xRg(K).Offset(0, 1).Value) Then ' vérifie si la valeur de la colonne suivante est une date valide xRg(K).EntireRow.Copy Destination:=Worksheets("test").Range("A" & J + 1) J = J + 1 End If Next Application.ScreenUpdating = True End Sub
Dans ce code, la condition "If IsDate(xRg(K).Offset(0, 1).Value) Then" vérifie si la valeur de la colonne suivante à celle contenant "ok" est une date valide. Si c'est le cas, la ligne est copiée/déplacée dans la feuille "test".