1 pièce(s) jointe(s)
Boucle While à deux arguments
Bonjour à tous,
J'ai adapté un code que j'utilisais déjà dans un autre fichier, et cette fois-ci, j'ai besoin de faire une boucle avec deux arguments, mais je ne pense pas que la boucle While convienne dans ce cas-là.
Pour vous donner du contexte, j'ai un onglet "Résultats" contenant une succession de tableaux (colonnes A à F). Dans la colonne A se trouve le numéro/nom de l'onglet dont proviennent les données en colonne C (exemple de noms : 01, 02, 03 etc)
Pièce jointe 617969
Dans l'onglet "Import", je souhaite coller les données contenues en colonne B & C de "Résultats", à partir de C8. Seulement, je ne souhaite coller que les données qui remplissent deux conditions :
Condition 1 : en H2 de l'onglet "Import", on va inscrire le nom de l'onglet que l'on veut traiter (par exemple : 02). Je ne veux copier que les lignes qui auront en colonne A de "Résultats" la même valeur que H2 de "Import" (pas de problème sur cette étape)
Condition 2 : en colonne C de "Résultats", il y a plusieurs mises en forme conditionnelles. En plus de la condition 1, je voudrais également que les données copiées répondent à ce critère : .DisplayFormat.Interior.Color = RGB (255,199, 206)
Voici donc le code utilisé :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
Sub Remplissage()
Dim a As Integer, Ligne As Long, Lg As Long, rFind As Range
a = ActiveSheet.Range("H2") ' numéro d'onglet placé dans H2
Lg = 8 ' n° ligne à partir de laquelle recopier à la suite les données
Set rFind = Sheets("Résultats").Columns("A").Find(a) ' Recherche numéro d'onglet en colonne A de "Résultats"
If rFind Is Nothing Then
MsgBox "Numéro d'onglet non trouvé"
Exit Sub
End If
Ligne = rFind.Row '--- n° ligne première facture trouvée
Set rFind = Nothing
Application.ScreenUpdating = False ' désactive rafraichissement écran
With Sheets("Résultats")
While .Range("A" & Ligne) = a And Cells(Ligne, 3).DisplayFormat.Interior.Color = RGB(255, 199, 206) '--- boucle sur les lignes de "trié DEF", arrêt dès que a non trouvé
.Range("B" & Ligne & ":C" & Ligne).Copy
ActiveSheet.Range("C" & Lg).PasteSpecial Paste:=xlPasteValues
Lg = Lg + 1 '--- ligne suivante
Ligne = Ligne + 1 '--- ligne suivante
If Lg > 9 Then
Rows(Lg).Insert Shift:=x1Down, CopyOrigin:=x1FormatFromLeftOrAbove
End If
Wend
End With
Application.ScreenUpdating = True
End Sub |
En appliquant ce code, il ne se produit rien (lorsque que je retire la partie And de la boucle, cela fonctionne bien).
Si j'ai bien compris le fonctionnement de la boucle While, elle s'arrête dès qu'un élément ne correspond plus. Donc dans mon cas, elle n'a pas la possibilité de tourner sur tout mon tableau.
j'hésite donc au type de boucle approprié.
Pour information, dans l'onglet "Résultats", les données sont bien triées : c'est-à-dire que les noms d'onglet en colonne A sont bien regroupés (les lignes 01 sont suivies des lignes 02, puis 03... il n'y a pas de mélange)
Auriez-vous un conseil sur le type de boucle à utiliser ?
Merci par avance pour votre aide !
