Inserer lignes

Bonsoir,

Je souhaiterai avoir aide sur le cas suivant s'il vous plait

dans l'exemple en fichier joint je voudrais grace a une macro vba : dans la Colonne F si il a deux numero inserer la meme lignes de donnees en ajoutant le deuxieme numero

Pour etre plus précis le fichier joint avant et après

Merci

Salut Kamellias,

• un double-clic n'importe où pour traiter le fichier ;
• si une valeur en [F] entr dans les conditions, le traitement est appliqué à la ligne concernée.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Cancel = True
Application.EnableEvents = False
'
For x = Range("A" & Rows.Count).End(xlUp).Row To 4 Step -1
    If InStr(Trim(Range("F" & x - 1).Value), " ") > 0 Then
        Rows(x).Insert shift:=xlDown
        Range("A" & x & ":F" & x).Value = Range("A" & x - 1 & ":F" & x - 1).Value
        Range("F" & x).Value = Split(Range("F" & x - 1).Value, Chr(32))(1)
        Range("F" & x - 1).Value = Split(Range("F" & x - 1).Value, Chr(32))(0)
    End If
Next
'
Application.EnableEvents = True
'
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iRow%
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("F:F")) Is Nothing Then
    If Target.Count = 1 And Target <> "" Then
        iRow = Target.Row
        If InStr(Trim(Range("F" & iRow).Value), " ") > 0 Then
            Rows(iRow + 1).Insert shift:=xlDown
            Range("A" & iRow + 1 & ":F" & iRow + 1).Value = Range("A" & iRow & ":F" & iRow).Value
            Range("F" & iRow + 1).Value = Split(Range("F" & iRow).Value, Chr(32))(1)
            Range("F" & iRow).Value = Split(Range("F" & iRow).Value, Chr(32))(0)
        End If
    End If
End If
'
Application.EnableEvents = True
'
End Sub

A tester, comme on dit...

A+

Je te remercie curulis57

C'EST SUPER ! CA FONCTIONNE COMME JE LE SOUHAITE