Insertion d'une ligne si conditions respectées

Bonjour à toutes et à tous,

Je suis débutant en Vba et je n'arrive pas à faire une macro qui permet d'ajouter une ligne sous deux conditions.

Pour expliquer simplement :

La feuille "critere" est le point de départ. On y trouve un tableau avec en ordonnée des noms de régions (Bretagne, Ile de France, Nouvelle Aquitaine) et en abscisse des critères lambdas (C1, C2, C3).

Un point important est le fait que le nombre de régions peut évoluer tandis que les critères seront toujours C1, C2 et C3.

Pour exprimer mon besoin, voici un exemple :

Imaginons que six cases comprennent un X (Bretagne/C1, Bretagne/C2, Ile de France/C1, Ile de France/C2, Nouvelle Aquitaine/C1 et Nouvelle Aquitaine/C2.

S'il y a un X, le programme doit ajouter une ligne dans la feuille nommée "Data" au niveau de Bretagne , Ile de France et Nouvelle Aquitaine "sous" les critères C1 et C2.

Le programme doit de plus écrire dans les six lignes ajoutées le mot compris dans la case "A1" sur la feuille "critere".

Ce mot doit être surligné en vert.

S'il n'y a pas de "X" mais un "-", alors le programme ne doit pas ajouter de ligne.

Afin d'illustrer cette explication, j'ai ajouté dans le fichier Excel la feuille "Résultat voulu" qui illustre ce que le programme doit me permettre d'obtenir comme résultat.

Vous trouverez dans mon post le fichier Excel.

J'ai essayé d'écrire une macro mais sans succès...

Sub Insereligne() 'Insertion d'une ligne s'il y a un X dans la case, sinon ne pas ajouter de ligne

Dim VRegion As Range, Vcritere As Range, Plage As Range, Plage1 As Range Dim wsE As Worksheet Dim wsB As Worksheet Dim i As Integer, j As Integer

Set wsE = ThisWorkbook.Worksheets("critere")

Set wsB = ThisWorkbook.Worksheets("Data")

wsE.Activate

Set Plage = Range(Cells(3, 2), Cells(65000, 2)) Set Plage1 = Range(Cells(3, 3), Cells(65000, 5))

For Each VRegion In Plage

For Each Vcritere In Plage1

For i = 1 To wsB.Cells(Rows.Count, 1).End(xlUp).Row

For j = 1 To wsB.Cells(3, Columns.Count).End(xltolft).Column - 1

If Cells(i, 1) = Vregion And Cells(i, j) = "X" Then

wsB.Cells(i, 1).EntireRow.Insert Shift:=xlDown

Exit For

End If

Next

End Sub

Un grand merci à ceux qui prendront le temps de répondre à ce post.

Très bonne journée à vous !

LDDR