Problème dans mon code [Recherche d'une cellule puis d'une autre] [RESOLU]

[macadamx]

Bonjour à tous !
Dans mon code, j'ai plusieurs problèmes, je n'arrive pas à faire finir l'exécution de la macro lorsque celle ci arrive à une cellule vide et cela me copie tout sans exception même si ce que je demande est faux.
Comment puis je faire ?

Merci de votre aide !
Cela ne me met pas de rapport d'erreur donc rien à mettre en surbrillance...

Sub mesures_en_retard()
Sheets("game").Select
Range("A1").Select

Sheets("MESURES EN RETARD").Select
'Je met en memoire la Sheet créée, comme ca je peux l'appeler facilement ensuite :
Set SheetSauvegarde = ThisWorkbook.ActiveSheet
'Ensuite je choisi ou je vais écrire la colonne total. Ici ce sera la cell A1 :
SauvegardeRow = 1
SauvegardeColumn = 1

Sheets("game").Select

Retard = 0

Range("A1").Select

Cells.Find(What:="Date Fin Prévue", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

datefinprévue = ActiveCell.Column

'Maintenant qu'on a la ligne de 'Date de fin prévue', on cherche dans cette ligne la colonne 'total'
ActiveCell.EntireRow.Select
Set MyRg = Selection
'On balaye toutes les cells de la ligne et on regarde si elles contiennent "Total"
For Each c In MyRg:


'la on cherche 'date de fin effective
If c.Value = "Date Fin Effective" Then
'Si on la trouve, on note son numero dans la variable datefineffective et on quit la boucle
datefineffective = c.Column
Exit For
End If

Next c

Columns(datefinprévue).Select
ActiveCell.EntireColumn.Select
Set MyRg = Selection
'On balaye toutes les cells de la colonne et on regarde ce qu'elle contiennent
For Each c In MyRg:

If c.Value < Now Then

c.EntireRow.Copy (SheetSauvegarde.Cells(SauvegardeRow, SauvegardeColumn))
SauvegardeRow = SauvegardeRow + 1
End If


Next c

End Sub

 

[Kevin B]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Bonjour,

Est ce que vous pouvez fournir un fichier exemple svp.

Sinon essayez avec "on error resume next"

Cdt

Kevin

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Bonjour,

Merci de votre réponse, mais où devrait je placer le on resume next ?

Cdt,

Johan

 

[Kevin B]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Sub mesures_en_retard()
Sheets("game").Select
Range("A1").Select

Sheets("MESURES EN RETARD").Select
'Je met en memoire la Sheet créée, comme ca je peux l'appeler facilement ensuite :
Set SheetSauvegarde = ThisWorkbook.ActiveSheet
'Ensuite je choisi ou je vais écrire la colonne total. Ici ce sera la cell A1 :
SauvegardeRow = 1
SauvegardeColumn = 1

On error goto er

Sheets("game").Select

Retard = 0

Range("A1").Select

Cells.Find(What:="Date Fin Prévue", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

datefinprévue = ActiveCell.Column

'Maintenant qu'on a la ligne de 'Date de fin prévue', on cherche dans cette ligne la colonne 'total'
ActiveCell.EntireRow.Select
Set MyRg = Selection
'On balaye toutes les cells de la ligne et on regarde si elles contiennent "Total"
For Each c In MyRg:


'la on cherche 'date de fin effective
If c.Value = "Date Fin Effective" Then
'Si on la trouve, on note son numero dans la variable datefineffective et on quit la boucle
datefineffective = c.Column
Exit For
End If

er:
Next c

Columns(datefinprévue).Select
ActiveCell.EntireColumn.Select
Set MyRg = Selection
'On balaye toutes les cells de la colonne et on regarde ce qu'elle contiennent
For Each c In MyRg:

If c.Value < Now Then

c.EntireRow.Copy (SheetSauvegarde.Cells(SauvegardeRow, SauvegardeColumn))
SauvegardeRow = SauvegardeRow + 1
End If


Next c

End Sub

Essayez avec ce code et dites moi si cela fonctionne

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

J'ai vérifié avec un msgbox sur la valeur de c.value et la réponse à si c'est > aujourd'hui et ça me donne une date supérieur mais pas la bonne réponse...

Je ne comprend pas

 

[Kevin B]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Est ce que tu as un fichier d'exemple à fournir stp

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Voilà,

J'ai anonymisé mon fichier

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Après, j'ai retiré une ligne qui devait recherchée si la colonne date de fin effective était vide pour ensuite copier la ligne car ça ne fonctionnait pas du tout...

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

J'ai modifié mon code mais là, ça n'enregistre aucune valeur ....

Sub mesures_en_retard()
Sheets("game").Select
Range("A1").Select

Sheets("MESURES EN RETARD").Select
'Je met en memoire la Sheet créée, comme ca je peux l'appeler facilement ensuite :
Set SheetSauvegarde = ThisWorkbook.ActiveSheet
'Ensuite je choisi ou je vais écrire la colonne total. Ici ce sera la cell A1 :
SauvegardeRow = 1
SauvegardeColumn = 1

On Error GoTo er

Sheets("game").Select

Range("A1").Select

Cells.Find(What:="Date Fin Prévue", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

datefinprévue = ActiveCell.Column

'Maintenant qu'on a la ligne de 'Date de fin prévue', on cherche dans cette ligne la colonne 'total'
ActiveCell.EntireRow.Select
Set MyRg = Selection
'On balaye toutes les cells de la ligne et on regarde si elles contiennent "Total"
For Each c In MyRg:


'la on cherche 'date de fin effective
If c.Value = "Date Fin Effective" Then
'Si on la trouve, on note son numero dans la variable datefineffective et on quit la boucle
datefineffective = c.Column
Exit For
End If

er:

Next c

Columns(datefinprévue).Select
ActiveCell.EntireColumn.Select
Set MyRg = Selection
'On balaye toutes les cells de la colonne et on regarde ce qu'elle contiennent
For Each c In MyRg:

If c.Value < Now Then

c.EntireRow.Copy (SheetSauvegarde.Cells(SauvegardeRow, SauvegardeColumn))
SauvegardeRow = SauvegardeRow + 1
End If


'La ligne suivante permet de sortir de la boucle For. Car sinon il va faire TOUTES les cells de la colonne B et ca va etre long
'Pour en sortir, il regarde a chaque ligne si la valeur de la cellule dans la colonne ColumnCellCC (ici la colonne 1) est = à "Total" si c'est le cas il sort de la boucle
If Cells(c.Row, datefineffective).Value = "" Then Exit For

Next c

End Sub

 

[Kevin B]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Quel est l'objectif de ton code?

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

L'objectif de mon code étant de prendre la ligne de chaque occurence étant en retard par rapport à la date d'aujourd'hui....
Sauf si il y a une date de fin effective écrite, dans ce cas, cela ne copie pas la ligne...

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Petite MAJ : If Cells(c.Row, datefinprévue).Value = "" Then Exit For

 

[macadamx]

Re : Problème dans mon code [Recherche d'une cellule puis d'une autre]

Pour ceux que ça intéresse :

Sub mesures_en_retard()

Application.ScreenUpdating = False
Sheets("MESURES EN RETARD").Select
'Je met en memoire la Sheet créée, comme ca je peux l'appeler facilement ensuite :
Set SheetSauvegarde = ThisWorkbook.ActiveSheet
'Ensuite je choisi ou je vais écrire la colonne total. Ici ce sera la cell A1 :
SauvegardeRow = 2
SauvegardeColumn = 1
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents


Sheets("game").Select


Range("A1").Select


Cells.Find(What:="Date Fin Prévue", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate

datefinprévue = ActiveCell.Column

'Maintenant qu'on a la ligne de 'Date de fin prévue', on cherche dans cette ligne la colonne 'date de fin effective'
ActiveCell.EntireRow.Select


Set MyRg = Selection
'On balaye toutes les cells de la ligne et on regarde si la date est inférieure à la date d'aujourd'hui
For Each c In MyRg:



'la on cherche 'date de fin effective
If c.Value = "Date Fin Effective" Then
'Si on la trouve, on note son numero dans la variable datefineffective et on quit la boucle
datefineffective = c.Column
Exit For
End If


Next c


Columns(datefinprévue).Select
'ActiveCell.EntireColumn.Select


LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Set MyRg = Range(Cells(2, datefinprévue), Cells(LastRow, datefinprévue))
For Each c In MyRg:
'MsgBox c.Value
toto = DateDiff("d", c.Value, Date)

If DateDiff("d", c.Value, Date) > 0 Then
'MsgBox Cells(c.Row, datefineffective).Value
If Cells(c.Row, datefineffective).Value = "" Then



c.EntireRow.Copy (SheetSauvegarde.Cells(SauvegardeRow, SauvegardeColumn))
SauvegardeRow = SauvegardeRow + 1
End If
End If


'La ligne suivante permet de sortir de la boucle For. Car sinon il va faire TOUTES les cells de la colonne B et ca va etre long
'Pour en sortir, il regarde a chaque ligne si la valeur de la cellule dans la colonne ColumnCellCC (ici la colonne 1) est = à "Total" si c'est le cas il sort de la boucle
If Cells(c.Row, datefinprévue).Value = "" Then Exit For



Next c

En espérant que cela peut aider quelques personnes car j'ai eu du mal à trouver une solution.