Reprises de données Fermé

Question

Bonjour, 

J'ai un fichier excel dans lequel je dois pouvoir reprendre des données en fonction d'une colonne Etat (En cours/Terminé), Employé(x, y, z) et X autres colonnes qui ne servent qu'à rentrer des dates pour vérifier l'état de l'avancement de certaines tâches par mise en forme conditionnelles. 

Ce que je voudrais c'est pouvoir reprendre en un click tous les dossiers En cours, pour l'employé x dont les colonnes pour tâches sont en formatconditionnel de texte rouge.

J'ai écris ceci :

Dim i&, fin&, aa
With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin <= 2 Then Exit Sub
aa = .Range("A2:AJ" & fin)
For i = 2 To UBound(aa)
If aa(i, 7) = "En cours" And aa(i, 6) = "Boudry" And aa(Cells).Font.ColorIndex = 3 Then EntireRow.Select
Sheets("feuil2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Next i
.Range("A2").Resize(UBound(aa), UBound(aa, 2)).FormulaLocal = aa
End With


Mais ça bloque avec une erreur d'exécution 9 sur la ligne en gras. 

Quelqu'un pourrait-il m'aider svp? 
Configuration: Windows XP / Internet Explorer 8.0

melanie1324 · Answer

Bonjour,

Moi j'écrirais le code comme suit :

Dim i&, fin&, aa
With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin <= 2 Then Exit Sub

For i = 2 To fin
If cells(i, 7) = "En cours" And cells(i, 6) = "Boudry" And cells(i,7).Font.ColorIndex = 3 Then EntireRow.Select
Sheets("feuil2").Select
Selection.PasteSpecial Paste:=xlPasteValues
Next i

End With

JinRo · Answer

Bonjour, 

Merci de votre réponse, mais étrangement quand j'essaie votre solution
j'ai ma feuil2 qui scintille pendant 1mn à peu prêt puis je me retrouve avec la macro inscrite sur cette dernière... 

Mais rien de plus...

En modifier le code comme suit :
Sub calcul3()
Dim i&, fin&, aa

With Feuil1
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin <= 2 Then Exit Sub
For i = 2 To fin
If Cells(i, 7) = "En cours" And Cells(i, 6) = "Boudry" And Cells(i, 7).Font.ColorIndex = -16776961 Then EntireRow.Select
Sheets("Mail").Select
Selection.Paste Paste:=xlPasteValues
Next i
End With
End Sub


Le  -16776961 correspond à la couleur de la mise en forme conditionnelle et là 
J'ai le débugger qui me dit que la méthode PasteSpécial de la Classe Range a échoué. (erreur 1004). Malheureusement cela ne m'éclaire pas....

g_33 · Answer

bonjour

la suite avec le code de Melanie

Dim i&, fin&, aa 
With Feuil1 
fin = .Range("A" & Rows.Count).End(xlUp).Row 
If fin <= 2 Then Exit Sub 

For i = 2 To fin 
If cells(i, 7) = "En cours" And cells(i, 6) = "Boudry" And cells(i,7).Font.ColorIndex = 3 Then EntireRow.Select 
Sheets("feuil2").activate
derlig =Range("A" & Rows.Count).End(xlUp).Row +1
Sheets("feuil2").cells(derlig,1).Select
Selection.PasteSpecial Paste:=xlPasteValues 
Next i 

End With


cordialement

JinRo · Answer

Bonjour, 

Merci également de votre réponse mais encore une fois, j'ai la feuille qui scintille et sur la feuille de récupération de données... 

J'ai la macro qui s'écrit sur 5000 et des poussières de lignes...

J'avoue que là je suis complètement perdu O_O

JinRo · Answer

Bonjour à tous et un grand merci de votre aide ainsi que de votre compréhension. 

Malheureusement j'ai toujours un soucis... 

Je vous explique voici mon code de mise en forme conditionnelle :

Sub Misenformecond()
With Feuil1
       Cells.FormatConditions.Delete
    Range("K2:K30001").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$K2+30<AUJOURDHUI()"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = 3
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("L2:L30001").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$L2+30<AUJOURDHUI()"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = 3
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("M2:M30001").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$M2+30<AUJOURDHUI()"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = 3
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("N2:N30001").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$N2+30<AUJOURDHUI()"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = RGB(255, 0, 0)
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("O2:O30001").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$O2+7<AUJOURDHUI()"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = RGB(255, 0, 0)
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("P2:P30001").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$P2+60<AUJOURDHUI()"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = RGB(255, 0, 0)
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Range("Q2:Q30001").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$Q2+20<AUJOURDHUI()"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .Color = RGB(255, 0, 0)
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
     Range("A2:AJ3000").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$G2=""Terminé"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599963377788629
    End With
    Selection.FormatConditions(1).StopIfTrue = True
    End With
    
End Sub

C'est un code que j'ai fait à partir de l'enregistreur de macro. 
Maintenant en reprenant vos macros. J'ai une erreur inatendu : Erreur de compilation. Référence incorrecte ou non qualifiée.

Sub Calcul20()
Dim i&, fin&, aa
Sheets("Rentes").Select
fin = .Range("A" & Rows.Count).End(xlUp).Row
If fin <= 2 Then Exit Sub

For i = 2 To fin
Sheets("Rentes").Activate
If Sheets("Rentes").Cells(i, 7) = "En cours" And Sheets("Rentes").Cells(i, 6) = "Boudry" And Sheets("Rentes").Cells(i, 17).Font.Color = RGB(255, 0, 0) Then
 Rows(i).Copy
Sheets("feuil1").Activate
derlig = Range("A" & Rows.Count).End(xlUp).Row + 1
Sheets("feuil1").Cells(derlig, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End If
Next i

End Sub

Si je l'enlève le point devant Range, pas de soucis la macro tourne mais ne fait rien. 

J'ai du oublié quelque chose ou quelque chose m'échappe... malheureusement étant débutant et la fatigue n'aidant pas, je ne peux que m'en remettre à vous et à vos connaissances.

Par ailleurs, j'espère que vos explications me permettront d'avancer non seulement dans mon travail mais également dans mon autoformation.

michel_m · Answer

Bonjour

En VBA , on évite d'utiliser au maxi les méthodes "select", "copy", "paste" qui utilisent beaucoup de mémoire et ralentissent énormément l'exécution de la procédure
comme tu travailles avec des écritures de cellules au fur et à mesure il est essentiel de commencer par figer l'écran par
Application.ScreenUpdating = False

D'autre part il plus sécurisant de travailler en "bloc" par ex 
with sheets(1)
    code
end with
les range, column, row sont alors des propriétés de sheet et doivent être précédés d'un point (ton erreur tout à l'heure)
Il aurat été +judicieux   colonne 17 d'utiliser la cause de la mise en couleur plutôt que se baser sur la couleur: 
....And .Cells(Lig, "Q") + 20 < Date Then...
comme tu as déclaré en long, cad> 32767 lignes ("long"+ facile à lire que "&": merci pour la maintenance)
il serait + intéressant de passer uniquement par une variable -tableau dynamique (à partir de 1000 lignes env.) très rapide

toujours pour faciliter la lecture (maintenance), indente ton code

Option Explicit

Sub Calcul20()
Dim Lig As Long, fin As Long, T_ligne()

Application.ScreenUpdating = False
 With Sheets("Rentes")
     fin = .Range("A" & Rows.Count).End(xlUp).Row
     If fin <= 2 Then GoTo fin
     For Lig = 2 To fin
          If .Cells(Lig, 7) = "En cours" And .Cells(Lig, 6) = "Boudry" And .Cells(Lig, 17).Font.Color = RGB(255, 0, 0) Then
               T_ligne = .Range(.Cells(Lig, "A"), .Cells(Lig, "AJ"))
               With Sheets("feuil1")
                    fin = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & fin).Resize(1, 36) = T_ligne
               End With
          End If
     Next
End With

fin:
End Sub


procédure testée avec succès sur maquette (sauf test sur mise en forme conditionnelle) et en supposant que la ligne 1 de la feuille1 comporte des données
 
 Michel

JinRo · Answer

Bonjour à tous et navré pour ma réponse tardive. 
Malheureusement j'ai une peu de temps pour vous répondre et bcp de choses à faire tant au travail qu'à la maison. 

Je vous remercie à tous pour vos réponses elles m'ont beaucoup éclairé. 

Michel_M, pour ton information je débute complétement en vba mes connaissances se limitent à ce que je trouve sur le net, à l'explorateur d'objet et des exemples qu'on veut bien me montrer. 

Je vais devoir refaire un post pour un autre sujet qui concerne un USF et il me semble que tu me donnes un semblant de réponse par rapport à mon problème... 

En tout cas merci à tous ça fait plaisir de voir qu'il y a des gens sympas qui sont prêt à donner un coup de main à un novice comme moi. 

Excellente journée à tous!

JinRo · Answer

Bonjour à tous, 

Navré pour ma réponse tardive mais j'ai été très occupé entre le travail et vie familiale. 

Je vous remercie à toutes et à tous pour vos réponses qui m'ont aidé et qui m'ont permis d'en apprendre un peu plus sur la programmation VBA. 

Michel_M, merci pour ton explication. Elle me permet de comprendre un peu mieux comment délimiter certaines choses. Maintenant je dois apprendre à appliquer ce que vous avez eu la gentillesse de me montrer. 

J'apprends avec les macros automatique, l'explorateur d'objet ainsi que des exemples et solutions que je trouve sur le net et des bouquins que je lis entravers. Je sais que ce n'est pas la meilleure façon, mais je ne peux faire autrement. 

Par ailleurs, il me semble dans ta réponse avoir trouvé un semblant de réponse à une question que je vais devoir poser pour un USF qui met 16 sec à valider les données. 

Encore merci à tous d'avoir pris le temps de répondre à un novice comme moi. 

Excellente journée à vous!

Reprises de données

8 réponses

Discussions similaires