[VBA] Copier ligne avec plusieurs conditions
Bonjour,
Je n'ai pas trouvé de topic concernant mon cas, merci de me rediriger si jamais il y avait quelque chose de semblable.
Je vais essayer d'être clair. Je vous mets un screen en pj pour mieux comprendre (mon fichier s'actualise à partir de la date en C2 et d'un autre fichier, vous l'envoyer ne ferrait apparaitre que des erreurs).
Pour info, le tableau s'étend de B6 à K60.
Ce que je souhaite faire c'est copier les lignes (de la colonne B à K) dans la feuille "Anomalie conso" lorsque l'une de ces conditions est vérifiée (elles portent sur les colonnes B,G,I,K):
- Faire la copie que sur les cases de la colonne B sans remplissage (pas les grisées, pas les bleutées)
- Copier la ligne si les 3 cases en G,I,K sont rouges
- Copier si la ligne possède la case G rouge seule > 30%
Si les cases I,K sont rouges
-Copier si la moyenne des 2 cases est >10%
Si 2 cases sur 3 sont rouges:
-Copier si la moyenne des 2 cases est >50%
Il faudrait copier les lignes à la suite à partir de la ligne 5 si possible.
Je suis conscient que ça semble difficile mais ça serait super d'arriver à quelue chose de semblable.
En vous remerciant d'avance,
En fait on peut tourner le problème différemment.
Les couleurs étant issues de mise en forme conditionnelle, aussi pour les cellules grisées, on peut remplacer la condition "couleur rouge" par ">0" et mettre le cas non vide avec.
A mon avis ça allege l'écriture et simplifie le problème, notamment s'il faut faire des calculs.
J'ai commencé cette macro qui je pense marcherait mais je ne connais pas l'écriture de ce que j'ai écrit "Copy.Selection" pour copier la ligne dans la feuille "Anomalie conso" à la ligne "a".
Sub anomalie()
'Nombre ligne copié
Dim a As Single
a = 0
Sheets("EB").Select
For i = 6 To 60
Range("B" & i & ":" & "K" & i).Select
'Cas 3 tendances positives
If Cells(i, 7) > 0 And Cells(i, 9) > 0 And Cells(i, 11) > 0 Then
a = a + 1
Copy.Selection
End If
'Cas +50% mois précédent
If Cells(i, 7) > 0.5 Then
a = a + 1
Copy.Selection
End If
'Cas +10% moyenne des années en cours et précédente
If Not IsEmpty(Cells(i, 9)) And Not IsEmpty(Cells(i, 11)) Then
If Cells(i, 9) > 0 And Cells(i, 11) > 0 And (Cells(i, 9) + Cells(i, 11)) / 2 > 0.1 Then
a = a + 1
Copy.Selection
End If
End If
'Cas 2 tendances positives et +30% moyenne
If Cells(i, 7) > 0 Then
If Cells(i, 9) > 0 Then
If (Cells(i, 7) + Cells(i, 9)) / 2 > 0.3 Then
a = a + 1
Copy.Selection
End If
End If
If Cells(i, 11) > 0 Then
If (Cells(i, 7) + Cells(i, 11)) / 2 > 0.3 Then
a = a + 1
Copy.Selection
End If
End If
End If
Next
End Sub
ERRATUM
J'ai réussi à trouver la solution tout seul au final
Je la partage pour les intéressé:
Sub anomalie()
'Nombre ligne copié
Dim a As Single
a = 5
Sheets("Anomalie conso").Range("B6:K60").ClearContents
'Boucle sur les feuilles
For j = 1 To 3
Dim DernLigne As Long
DernLigne = Range("B" & Rows.Count).End(xlUp).Row
Sheets(j).Select
Sheets("Anomalie conso").Range("B" & a & ":" & "K" & a + 1) = Sheets(j).Range("B4:K5").Value
a = a + 1
For i = 6 To DernLigne
Range("B" & i & ":" & "K" & i).Select
If Cells(i, 6) <> 0 And IsNumeric(Cells(i, 7)) Then
'Cas 3 tendances positives
If Cells(i, 7) > 0 And Cells(i, 9) > 0 And Cells(i, 11) > 0 Then
a = a + 1
Sheets("Anomalie conso").Range("B" & a & ":" & "K" & a).Value = Range("B" & i & ":" & "K" & i).Value
'Cas +50% mois précédent
ElseIf Cells(i, 7) > 0.5 Then
a = a + 1
Sheets("Anomalie conso").Range("B" & a & ":" & "K" & a).Value = Range("B" & i & ":" & "K" & i).Value
'Cas +10% moyenne des années en cours et précédente
ElseIf IsNumeric(Cells(i, 9)) And IsNumeric(Cells(i, 11)) Then
If Cells(i, 9) > 0 And Cells(i, 11) > 0 And (Cells(i, 9) + Cells(i, 11)) / 2 > 0.1 Then
a = a + 1
Sheets("Anomalie conso").Range("B" & a & ":" & "K" & a).Value = Range("B" & i & ":" & "K" & i).Value
End If
'Cas 2 tendances positives et +30% moyenne
ElseIf Cells(i, 7) > 0 Then
If Cells(i, 9) > 0 And IsNumeric(Cells(i, 9)) Then
If (Cells(i, 7) + Cells(i, 9)) / 2 > 0.3 Then
a = a + 1
Sheets("Anomalie conso").Range("B" & a & ":" & "K" & a).Value = Range("B" & i & ":" & "K" & i).Value
End If
End If
If Cells(i, 11) > 0 And IsNumeric(Cells(i, 11)) Then
If (Cells(i, 7) + Cells(i, 11)) / 2 > 0.3 Then
a = a + 1
Sheets("Anomalie conso").Range("B" & a & ":" & "K" & a).Value = Range("B" & i & ":" & "K" & i).Value
End If
End If
End If
End If
Next
a = 20
Next
Sheets("Anomalie conso").Select
End Sub