Aide VBA Excel : Inserer des lignes sous condition

Résolu/Fermé
Clement79 - 22 avril 2014 à 15:05
conrade82
Messages postés
96
Date d'inscription
dimanche 21 avril 2013
Statut
Membre
Dernière intervention
9 septembre 2016
- 24 avril 2014 à 17:39
Bonjour,

Alors là, j'ai besoin de votre aide, je seche complement (vue mon faible niveau, cela m'étonne pas...)

Donc voila ma problématique.

Je voudrais dans une feuil inserer des lignes et y copier des informations provenant d'une autre feuille.

Plus précisement :
J'appuis sur un bouton dans Feuil10
La macro va chercher dans la Feuil1 en colonne B les valeurs = B2 de la Feuil10.
Chaque fois quelle trouve les valeurs égales, elles crée une ligne dans la feuille 10 (avec mise en forme) et copie sur cette ligne en colonne A la valeur de la Feuil1 colonne A.

Je sais pas si je suis clair et si c'est réalisable, j'attends vos commentaires...
Merci d'avance,
A voir également:

7 réponses

conrade82
Messages postés
96
Date d'inscription
dimanche 21 avril 2013
Statut
Membre
Dernière intervention
9 septembre 2016
4
Modifié par conrade82 le 23/04/2014 à 00:53
Bonjour,

Qu'y a-t-il dans Feuil10 outre le bouton et la valeur en B2 ? Pourquoi insérer une ligne ? Où voulez-vous insérer cette ligne ? Et avec quelle mise en forme ?

Voici une ébauche: il faudrait l'adapter à votre besoin puis la tester.

Option Explicit

Sub test()

Dim Lastli As Integer, rCell As Range

Lastli = Sheets("Feuil1").Cells(1, 1).End(xlDown).Row

For Each rCell In Sheets("Feuil1").Range("B2:B" & Lastli)
'Si valeur cellule égale B2 de Feuil10
If rCell = Sheets("Feuil10").Range("B2") Then
'Alors insérer une ligne en ligne 10 (par exemple)
With Sheets("Feuil10")
.Rows("10:10").Insert Shift:=xlDown
'Copy les données de la colonne A Feuil1 correspondantes
.Cells(10, 1).Value = Sheets("Feuil1").Cells(rCell.Row, 1).Value
End With
End If
Next rCell

End Sub

https://www.cjoint.com/?DDxa0pZMCmr

Cordialement,
Conrade82
0
Merci beaucoup, c'est exactement ce que je voulais.
Par contre, quand je l'applique exactement à mon cas je rencontre une erreure " L'indice n'appartient pas..." (If rCell = Sheets("Feuil9").Range("B6") Then)

Sub LancementListing()
Dim Lastli As Integer, rCell As Range
Lastli = Sheets("Feuil2").Cells(1, 1).End(xlDown).Row
For Each rCell In Sheets("Feuil2").Range("B6:B" & Lastli)
'Si valeur cellule égale B6 de Feuil9
If rCell = Sheets("Feuil9").Range("B6") Then
'Alors insérer une ligne en ligne 11 (par exemple)
With Sheets("Feuil9")
.Rows("11:11").Insert Shift:=xlDown
'Copy les données de la colonne S Feuil2 correspondantes
.Cells(10, 19).Value = Sheets("Feuil2").Cells(rCell.Row, 19).Value
End With
End If
Next rCell

End Sub

Je ne comprend pas d'où ça vient. De plus j'aimerais ajouter une boucle lorsque je appui sur le bouton. En effet je souhaiterais que la macro vérifie si les références ont déjà été rentrées et si oui, ne pas les remettent de nouveau.

Pour répondre à tes questions, dans le Feuil10 (en réalité Feuil9), il y a une sorte de nomenclature. Les lignes viennent s'intégrer à l'interieur. La mise en forme que je voudrais est uniquement de griser la cellule avec la valeur insérées.

J'en demande beaucoup...
0
conrade82
Messages postés
96
Date d'inscription
dimanche 21 avril 2013
Statut
Membre
Dernière intervention
9 septembre 2016
4
Modifié par conrade82 le 23/04/2014 à 15:19
Bonjour,

- "L'indice n'appartient pas..." (If rCell = Sheets("Feuil9").Range("B6") Then) "
Vérifiez l'orthographe de votre feuille? Si je prends pour exemple le fichier que j'ai crée pour effectuer ce code et que je change "Sheets("Feuil9")" par "Sheets("Feuil10")" alors que cette feuille n'existe pas, j'ai un message d'erreur. Un moyen de comprendre serait d'avoir le fichier Excel sur lequel vous coder.

- je souhaiterais que la macro vérifie si les références ont déjà été rentrées et si oui, ne pas les remettent de nouveau
La valeur de la cellule B6 de Feuil9 est-elle variable? Quelles sont les données variables dans Feuil2? Dans Feuil9, qu'entends-tu par "les lignes viennent s'intégrer à l'intérieur" ? Le but serait de définir la plage des données et d'effectuer la boucle en "For each... in..."

- La mise en forme que je voudrais est uniquement de griser la cellule avec la valeur insérées.
Remplace:

With Sheets("Feuil9")
.Rows("11:11").Insert Shift:=xlDown
'Copy les données de la colonne S Feuil2 correspondantes
.Cells(10, 19).Value = Sheets("Feuil2").Cells(rCell.Row, 19).Value
End With

par:


With Sheets("Feuil9")
.Rows("11:11").Insert Shift:=xlDown
'Copy les données de la colonne S Feuil2 correspondantes
With .Cells(10, 19)
.Value = Sheets("Feuil2").Cells(rCell.Row, 19).Value
.Interior.ColorIndex = 15 'on grise la cellule matchée
End With
End With
0
Encore un grand merci pour ton aide.
Donc alors, le problème est résolue, j'avais bien un problème d'orthographe.
Maintenant le fichier fonctionne et intègre dans mon tableau les lignes voulues.

- La valeur B6 est fixe et ne bouge jamais. Dans la feuille 2, les 2 données peuvent évoluer.
Pour l'intégration des ligne, la macro répond à ce critère en insérant des lignes (dans un tableau déjà existant, pas de soucis de ce côté là).

- Merci pour la mise en forme, c'est parfait.
0
conrade82
Messages postés
96
Date d'inscription
dimanche 21 avril 2013
Statut
Membre
Dernière intervention
9 septembre 2016
4
Modifié par conrade82 le 23/04/2014 à 22:42
Y a-t-il des données en colonne T Feuil9?
Il peut y a voir plusieurs fois la même valeur en colonne A de Feuil2?
0
Sur la Feuil9, j'ai des données jusqu'à la colonne AD

Pour la Feuil1, oui je retrouve plusieurs fois la même valeur. C'est là mon problème, j'aimerais les regrouper...
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
conrade82
Messages postés
96
Date d'inscription
dimanche 21 avril 2013
Statut
Membre
Dernière intervention
9 septembre 2016
4
24 avril 2014 à 08:00
Bonjour,

Ne veux-tu pas créer un tableau croisé dynamique et lancer ta macro à partir de ce tableau ? Ce serait plus pratique surtout si tes données sont variables. Ne sachant pas le processus de ces données, ma solution serait de créer un TCD de la Feuil1 soit dans la même Feuille soit dans une autre feuille et ensuite tu adaptes la macro en fonction ? Peux-tu poster un extrait de ta feuil1?
0
Merci de ton aide, finallement je m'en suis sorti avec le programme ci-dessous :

Option Explicit

Sub LancementListing1()

Dim Lastli As Integer, rCell As Range

Lastli = Sheets("Fiche").Cells(1, 19).End(xlDown).Row

'Fige l'écran pendant la suppression des lignes
Application.ScreenUpdating = False

For Each rCell In Sheets("Fiche").Range("U1:U" & Lastli)
    'Si valeur cellule égale B6 de Feuil9
    If rCell = ActiveSheet.Range("B6") Then
        'Alors insérer une ligne en ligne 12 (par exemple)
        With ActiveSheet
            .Rows("12:12").Insert Shift:=xlDown
            'Copy les données de la colonne S Feuil2 correspondantes
            With .Cells(12, 1)
              .Value = Sheets("Fiche").Cells(rCell.Row, 19).Value
              .Interior.ColorIndex = 15       'on grise la cellule matchée
            End With
            
            With .Cells(12, 2)
              .Value = Sheets("Fiche").Cells(rCell.Row, 6).Value
              .Interior.ColorIndex = 15       'on grise la cellule matchée
            End With
            
            With .Cells(12, 3)
              .Value = Sheets("Fiche").Cells(rCell.Row, 5).Value
              .Interior.ColorIndex = 15       'on grise la cellule matchée
            End With
            
            With .Cells(12, 5)
              .Value = Sheets("Fiche").Cells(rCell.Row, 12).Value
              .Interior.ColorIndex = 15       'on grise la cellule matchée
            End With
            
            With .Cells(12, 6)
              .Value = Sheets("Fiche").Cells(rCell.Row, 13).Value
              .Interior.ColorIndex = 15       'on grise la cellule matchée
            End With
            
            With .Cells(12, 7)
              .Value = Sheets("Fiche").Cells(rCell.Row, 14).Value
              .Interior.ColorIndex = 15       'on grise la cellule matchée
            End With
            
        End With
    End If
Next rCell
Call SupDoublons
Application.ScreenUpdating = True
End Sub


Sub SupDoublons()
    
    Dim Plage As Range, Cell As Range
    Dim Un As New Collection
    Dim Tableau() As Integer
    Dim x As Integer
 
    'Définit la plage de cellules pour la recherche de doublons
    Set Plage = ActiveSheet.Range("A10:A500")
 
    On Error Resume Next
    'Boucle sur les cellules de la plage cible
    For Each Cell In Plage
        'Création d'une collection de données uniques (sans doublons)
        Un.Add Cell, CStr(Cell)
 
        'Une erreur survient si l'élément existe dans la collection.
        'La procédure enregistre le numéro de ligne correspondant dans un tableau.
        If Err.Number <> 0 Then
            x = x + 1
            ReDim Preserve Tableau(1 To x)
            Tableau(x) = Cell.Row
            Err.Clear
        End If
    Next Cell
    On Error GoTo 0
 
    'On sort si aucun doublon n'a été trouvé.
    If x = 0 Then Exit Sub
 
     'Boucle sur le tableau pour supprimer les lignes contenant des doublons.
    For x = UBound(Tableau) To LBound(Tableau) Step -1
        ActiveSheet.Rows(Tableau(x)).EntireRow.Delete
    Next x
 
End Sub
0
conrade82
Messages postés
96
Date d'inscription
dimanche 21 avril 2013
Statut
Membre
Dernière intervention
9 septembre 2016
4
24 avril 2014 à 17:39
Well done! J'avoue que je commençais à sécher pour les doublons. Parfait! Bon courage pour la suite alors! N'oublie pas changer le statut de ta question...
0