Coller dans cellule vide en boucle

Question

Bonjour tout le monde,

Je reviens demander l'aide des amateurs de VB.

Mon application sélectionne dans une colonne les valeurs des cellules qui sont numériques, > 0 et en Gras. Une fois trouvée par la fonction, un font de couleur verte est appliquée.

Voici l'ensemble du code :

Dim Recherche As Range, Cellul As Variant, C As Variant


Sheets("Reporting").Range("H22:H35").Select
For Each Cellul In Selection
   Set Recherche = Sheets("Product-Licensor View").Rows("8:8").Find(Cellul, LookIn:=xlValues, MatchCase:=True, _
    SearchFormat:=False).EntireColumn
    
       On Error Resume Next
  
    If Not Recherche Is Nothing Then
       For Each C In Sheets("Product-Licensor View").Range(Recherche.Address).Offset(0, 0)            If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then C.Interior.ColorIndex = 4
       Next C
    End If
    
Next Cellul

Je voudrais que chacune des cellules avec font vert soient coller dans Sheets("Reporting"). Range ("J22"), les unes en dessous des autres. (donc en J22, J23, J24....)

Je me pose 2 questions:
-qu'elle est la structure pour copier les cellules les unes en dessous des autres ?
- est-ce que je dois recréer une boucle à l'intérieur du code existant ?

Je remercie par avance les personnes souhaitant m'aider.

Vinzfloz1

jmfmarques · Answer

A mon himble avis et bien que ne possédant pars VBA !

Qu'est-ce qui tempêche de le faire dans la boucle même qui sélectionne ces cellules, immédiatement après :
  If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then
      C.Interior.ColorIndex = 4  '---->> ce que tu fais déjà
      '-----ici ce que tu veux ajouter...(inscription dans les cellules de l'autre feuille)
 end if

Je ne vois pas l'utilité d'une autre boucle, dans cette affaire-là

jmfmarques · Answer

Et si tu ne veux pas "voyager" constamment entre une feuille et l'autre, rien ne t'empêche, dans ta boucle, d'alimenter un tableau et, une fois la boucle terminée, de "verser" ce tableau dans ton autre feuille.

Vinzfloz1 · Answer

JM je te remercie de ta réponse.

Je viens de rajouter la ligne suivante à l'endroit que tu m'as indiqué. Cependant, le résultat n'est qu'une suite de cellules blanches.
Donc cette ligne ne va pas. Par contre je suis d'accord avec toi, une autre boucle n'est pas nécessaire.

If C.Interior.ColorIndex = 4 Then C.Value.Copy: Sheets("Reporting").Range("J22").Paste

Je souhaiterais que les valeurs sélectionnées se collent l'une en dessous de l'autre. Je sais qu'il existe une possibilité acec XlDown mais aucune idée comment l'incorporer à cette ligne.

Vinz

mortalino · Answer

Salut,

j'ai beau lire et relire, je ne comprends pas exactement ce que tu veux faire !!

Tu mets en vert les cellules numériques et supérieur à 0, mais après, que veux tu faire ? 
--> copier QUE les cellules avec fond vert les uns après les autres ailleurs ?

Sinon, pour infos, Cellul As Variant et C As Variant, c'est pas très bon, il vaut mieux Cellul As Range et C As Range.

@++ 

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>

jmfmarques · Answer

Ben (je ne connais toujours pas VBA, mais...)
Au lieu de Range("J22")

Je mettrais en route un compteur (une raviable nb s'incrémentant de 1 à chaque cellule retenue et j'utiliserais alors :
Range("J" & str(22 + nb))

Mets celà en bonne syntaxeVBA pour moi (si cette syntaxe là ne va pas)

je ne comprends pas, par ailleurs, pourquoi tu répêtes ton if !
Si ta syntaxe est bonne, ce devrait être :

If Not Recherche Is Nothing Then
       For Each C In Sheets("Product-Licensor View").Range(Recherche.Address).Offset(0, 0)            If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then
               C.Interior.ColorIndex = 4
               C.Value.Copy: Sheets("Reporting").Range("J" & str(22 + nb))
            end if
       Next C
    End If

En admettant que ta syntaxe de copie est la bonne (je n'en sais rien) et que ty aies déclaré la variable nb

Vinzfloz1 · Answer

Bonjour,

Merci à vous deux pour vos réponse.


JM, pour quelqu'un qui ne connais toujours pas VBA, tu as l'air de te débrouiller pas mal du tout. 
Moi par contre...je bricole et là j'ai un problème pour mettre en place le compteur dont tu parles.
 
Voici le code avec ta ligne de code :

Dim Recherche As Range, Cellul As Range, C As Range
Dim nb As Range




Sheets("Reporting").Range("H22:H35").Select
For Each Cellul In Selection
   Set Recherche = Sheets("Product-Licensor View").Rows("8:8").Find(Cellul, LookIn:=xlValues, MatchCase:=True, _
    SearchFormat:=False).EntireColumn
    
       On Error Resume Next
  
    If Not Recherche Is Nothing Then
       For Each C In Sheets("Product-Licensor View").Range(Recherche.Address).Offset(0, 0)            If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then C.Interior.ColorIndex = 4: C.Value.Copy: Sheets("Reporting").Range ("J" & Str(22 + nb))
            Set nb = 1
            C.Value.Copy: Sheets("Reporting").Range ("J" & Str(22 + nb))


       Next C
    End If
    
Next Cellul

Ca bloque au niveau de nb = 1, le message incompatibilité de type apparaît.

Comment faire ? j'ai essayé de remplacer ActiveCell.ROws.Count + 1 mais ca ne fonctionne pas non plus.

Pour Martilino, je vais essayer de reformuler :
Je souhaite copier chaque cellule sur fond vert dans une colonne située sur une autre feuille.

Vinz

Vinzfloz1 · Answer

Rebonjour,

Une possible solution serait de définir en tant que variable la cellule où copier les données. Cette cellule serait la première cellule vide de la colonne J, à partir de J22.

Si quelqu'un à une idée... 

Merci à tous


Vinz

Vinzfloz1 · Answer

Salut,

Je tourne et retourne mon code, mais pas moyen, les valeurs ne se collent pas dans la deuxième feuille :

Voici le code :
If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then
            C.Interior.ColorIndex = 4
            C.Locked = False
            C.FormulaHidden = False
            Cell_Départ = "J22"
            C.Copy
            Sheets("Reporting").Range(Cell_Départ).End(xlDown)(1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
                            
            End If

J'ai essayé de déverrouiller les cellules, car je pensais que le problèmes venaient de là, mais cela ne change rien, après execution du code, les cellules sont bien déverrouillées. Mais le Copier/Coller ne passe pas, je commence à craquer.

Si quelqu'un a une idée, je lui serais très reconnaissant !!

Vinz

jmfmarques · Answer

Et si tu essayais de nommer la colonne J de ton autre feuille, en "ColJ", par exemple,
puis

If Not Recherche Is Nothing Then
       coucou = "ColJ"
       nb = 0
       For Each C In Sheets("Product-Licensor View").Range(Recherche.Address).Offset(0, 0)            If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then
               C.Interior.ColorIndex = 4
               Sheets("Reporting").cells(22 + nb, range(coucou).Column)=  C..Value
              nb = nb + 1
       Next C
 End If

Bon...
J'ai écrit celà car tu n'as pas de réponses, mais, une autre fois, je ne connais rien en VBA et j'ai pu écrire une énorme bêtise, donc...
Mais l'idée est là et tu y vois également comment et où incrémenter ton compteur nb...

A toi de jouer un peu....
bonne chance

jmfmarques · Answer

corriger  C..Value en C.Value (1 seul point, bien sur)

jmfmarques · Answer

Houlà !
J'ai aussi oublié un end if !
Bon ! on reprend donc :

If Not Recherche Is Nothing Then
       coucou =  "ColJ"
       nb = 0
       For Each C In Sheets("Product-Licensor View").Range(Recherche.Address).Offset(0, 0)            If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then
               C.Interior.ColorIndex = 4
               Sheets("Reporting").cells(22 + nb, range(coucou).Column)=  C . Value
              nb  = nb + 1
           End If
       Next C
 End If

mortalino · Answer

Vous faites (a mon gout) des choses trop complexes et qui bouffent enormément de mémoire (les Range).

Pourquoi ne pas faire une boucle style
For i = 1 To DerniereLigne
   If IsNumeric(Cells(i, 1).Value) And Cells(i, 1).Value > 0 Then Couleur Verte
Next i

^^ en gros, bien sur

Ensuite tu copies la colonne vers la colonne de destination, et tous ce qui n'est pas vert, tu supprimes la cellule en remontant les autres.
Je trouve ça hyper simple, plus rapide, et plus optimal que les Set c = ...

@++ 

<hr width="100%" size="2" />
  --Mortalino--
Le mystérieux chevalier, "Provençal, le Gaulois"
/DIV>

Vinzfloz1 · Answer

Bonjour, 

Merci à tous les 2.


Je crois que je n'arrive pas à faire simple :)


Avec le code suivant, ça fonctionne, mais effectivement, ça bouffe pas mal de mémoire. Enfin bon, je peux avancer.

For Each C In Sheets("Product-Licensor View").Range(Recherche.Address).Offset(0, 0)
                 If C.Value > 0 And C.Font.Bold True And IsNumeric(C.Value) True Then
            C.Interior.ColorIndex = 4
            C.Locked = False
            C.FormulaHidden = False
            While Sheets("Reporting").Range("J22").Value <> ""
            Range("J").Insert.EntireRow
            Wend
            Sheets("Reporting").Range("J22") = C.Value
            End If
            
                 
                                   
            Next C

En tout cas merci pour votre aide.

Vincent

cs_MPi · Answer

Regarde ton autre message
Le Offset(0,0) ne vaut rien en soit.
Si tu veux rechercher les cellules de gauche à droite, ce doit être Offset(0,X) o;u X est incrémenté de 1
Mais regarde l'autre message pour laisser tomber Offset()

Comme JMFMarqués te le mentionnait au début, le mieux serait de mettre les valeurs des cellules vertes dans un tableau(). Une fois la boucle de recherche / coloriage terminée, tu retournes dans ta feuille où tu veux copier les données et tu fais une autre boucle pour inscrire tes données 
For i = 0 to UBound(Tablo)
Range("J22").Offset(i, 0) = Tablo(I)
next

MPi

Coller dans cellule vide en boucle

14 réponses

Votre réponse

Discussions similaires