Insérer une ligne en fonction d'un résultat (feuilles différentes)

re,

à tester,

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, lastRw As Long, i As Integer
Dim sh1 As Worksheet, sh2 As Worksheet

Set sh1 = Sheets("RECAP")
Set sh2 = Sheets("DETAIL")

With sh2

    If Not Application.Intersect(Target, Columns("I")) Is Nothing Then

    lastRw = .Cells(Rows.Count, "B").End(xlUp).Row + 1

'    ======================================================================
        nb = Application.CountIf(sh1.Range("B:B"), sh1.Cells(Target.Row, "B"))
        If nb <> 0 Then
            tr = Application.Match(sh1.Cells(Target.Row, "B"), sh2.Range("B:B"), 0)
            nbr = Application.Sum(sh1.Range("G" & Target.Row & ":I" & Target.Row))
            sh2.Rows(tr & ":" & tr + nb).Delete Shift:=xlUp
            sh2.Rows(tr & ":" & tr + nbr).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

            lastRw = tr
        End If
'    ======================================================================

        .Cells(lastRw, "B") = sh1.Cells(Target.Row, "B").Value
        .Cells(lastRw, "C") = sh1.Cells(Target.Row, "C").Value
        .Cells(lastRw, "D") = sh1.Cells(Target.Row, "D").Value
        .Cells(lastRw, "E") = sh1.Cells(Target.Row, "E").Value
        .Cells(lastRw, "F") = sh1.Cells(Target.Row, "F")
        .Cells(lastRw, "G") = Year(sh1.Cells(Target.Row, "F"))

        With sh2.Range("B" & lastRw & ":K" & lastRw)
            .Interior.Color = RGB(255, 242, 204)
            .Font.Bold = True
        End With

        For Each c In sh1.Range("G" & Target.Row & ":I" & Target.Row)
            For i = 1 To c.Value
                lastRw = lastRw + 1

                .Cells(lastRw, "B") = sh1.Cells(c.Row, "B").Value
                .Cells(lastRw, "C") = sh1.Cells(c.Row, "C").Value
                .Cells(lastRw, "D") = sh1.Cells(c.Row, "D").Value
                .Cells(lastRw, "H") = sh1.Cells(3, c.Column).Value
            Next i
        Next c
    End If
End With
End Sub

Hello !!

Désolé pour ce retour si tardif, j'ai eu des petits soucis....

J'ai testé ton code, on est quasi parfait, j'ai juste une erreur "13" incompatibilité de type lorsque je rentre une nouvelle ligne tout en bas (donc si je ne mets pas à jour un code existant, mais simplement si j'entre une nouvelle ligne de données).

L'erreur se trouve ici à partir d'ici sur ton nouveau code :

sh2.Rows(tr & ":" & tr + nb).Delete Shift:=xlUp

Comment la corriger ??

Merci !!!

Hello à tous et bonne année !

Est-ce que quelqu'un aurait une idée pour résoudre une fois pour toute mon problème ci-dessus svp ???

Merci !!!

Up svp !!