Aide VBA Excel : Inserer des lignes sous condition

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

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.

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

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?

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

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