Dupliquer et inserer une ligne automatiquement d'apres la valeur d'une cellule

Sub DupliqueLigne()
 Dim i As Long, j As Byte, Flag As Boolean, TabCible

 TabCible = Array("HC30MB", "13OTHTAX") 'liste des codes pour lesquels on duplique la ligne; possible d'en rajouter
 With Worksheets("IMPORT")
 For i = .Range("A" & .Rows.Count).End(xlUp).Row To 2 Step -1
    Flag = False
    For j = LBound(TabCible) To UBound(TabCible)
        If Cells(i, 10) = TabCible(j) Then
            Flag = True
            Exit For
        End If
    Next j
    If Flag Then ' si correspondance
        Rows(i).Copy
        Rows(i).Insert Shift:=xlDown
        Cells(i + 1, 1) = "A3"
    End If
 Application.CutCopyMode = False
 Next i
 End With
End Sub

Sub DupliqueLigne()
 Dim MonTAb, TabCible, TabFinal(), i As Long, j As Long, Flag As Boolean, x As Long
 
 TabCible = Array("HC30MB", "13OTHTAX") 'liste des codes pour lesquels on duplique la ligne

 With Worksheets("IMPORT")

 MonTAb = .Range("A2:O" & .Range("A" & .Rows.Count).End(xlUp).Row)
 For i = LBound(MonTAb) To UBound(MonTAb)
    Flag = False
    x = x + 1
    ReDim Preserve TabFinal(1 To UBound(MonTAb, 2), 1 To x)
    For j = LBound(MonTAb, 2) To UBound(MonTAb, 2)
        TabFinal(j, x) = MonTAb(i, j)
    Next j
    
    For j = LBound(TabCible) To UBound(TabCible)
        If MonTAb(i, 10) = TabCible(j) Then
            Flag = True
            Exit For
        End If
    Next j
    If Flag Then ' si correspondance
        x = x + 1
        ReDim Preserve TabFinal(1 To UBound(MonTAb, 2), 1 To x)
        For j = LBound(MonTAb, 2) + 1 To UBound(MonTAb, 2)
            TabFinal(j, x) = MonTAb(i, j)
        Next j
        TabFinal(1, x) = "A3"
    End If
 Next i
 .Range("A2:O" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
 .Range("A2").Resize(UBound(TabFinal, 2), UBound(TabFinal, 1)) = Application.Transpose(TabFinal)
 End With
End Sub