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

macadamx

XLDnaute Junior
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
 
Dernière édition:

Kevin B

XLDnaute Junior
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

XLDnaute Junior
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
 

macadamx

XLDnaute Junior
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

XLDnaute Junior
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
 

macadamx

XLDnaute Junior
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

XLDnaute Junior
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.
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 907
Membres
101 836
dernier inscrit
karmon