Hi there,

I'm experiencing some troubles with the following MACRO. Everything is doing good, except that the macro only takes the first keyword into account not all of them.And I actually need the macro to apply itself on all the lines with the keywords as indicated in the macro below:

Sub Insertionsligne()

Dim Cel As Range
Dim Texte
Dim I As Integer
Dim J As Integer

Texte = Array("Electromécanique", "Electrique", "Informatique") ' Here it only applies on the first keyword found, the other ones are not taken into account
For I = 0 To UBound(Texte)

Set Cel = Worksheets("Feuil2").Columns("A:A").Find(Texte(I), , xlValues, xlWhole)

If Not Cel Is Nothing Then

I = Cel.Row

Rows(I + 1 & ":" & I + 5).Insert xlDown

Range("A" & I).AutoFill Range("A" & I & ":A" & I + 5), 1

Range("C" & I).Cut Destination:=Range("B" & I + 1)
Range("D" & I).Cut Destination:=Range("B" & I + 2)
Range("E" & I).Cut Destination:=Range("B" & I + 3)
Range("F" & I).Cut Destination:=Range("B" & I + 4)
Range("G" & I).Cut Destination:=Range("B" & I + 5)

End If

Next I

End Sub

Thaanks for your help guys,