Aide VBA Excel : Inserer des lignes sous condition

Résolu

Clement79 -
conrade82 Messages postés 96 Date d'inscription Statut Membre Dernière intervention - 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,

Afficher la suite

A voir également:

Vba insérer une ligne sous condition
Insérer une vidéo dans powerpoint - Guide
Partager photos en ligne - Guide
Excel cellule couleur si condition texte - Guide
Insérer signature word - Guide
Insérer liste déroulante excel - Guide

7 réponses

Réponse 1 / 7

conrade82 Messages postés 96 Date d'inscription Statut Membre Dernière intervention 4

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

Réponse 2 / 7

Clement79

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...

conrade82 Messages postés 96 Date d'inscription Statut Membre Dernière intervention 4

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

Réponse 3 / 7

Clement79

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.

conrade82 Messages postés 96 Date d'inscription Statut Membre Dernière intervention 4

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?

Réponse 6 / 7

Clement79

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

Discussions similaires

Range avec une Variable

convertir texte en nombre dans une macro

comment remplir un combobox à partir d'un colonne

Craquer mot de passe projet VBA

VBA : Copier valeur de cellules dans une autre feuilles

Afficher les données d'un tableau dans un formulaire VBA

Votre réponse

Discussions similaires