Problème avec mon code VBA (ajout de lignes)

Bonjour à toutes et tous,

Je vous explique mon problème, j'ai un code VBA (qui m'a été corrigé, et amélioré par ThauThème que je remercie grandement) qui copie depuis une base de données des prospects vers une feuille qui est propre à chaque commerciaux (chaque commercial à une feuille avec les prospects qui lui sont attribué).

A chaque nouveau prospect, nous créons une ligne afin de l'enregistrer et lui attribuer un commercial qui va le contacter. Sauf que le code m'autorise de créer une ligne (en ligne 2) sur ma base de données mais je ne peux pas écrire dessus.

Voici le code utiliser (fonctionne très bien mais empêche la création de ligne supplémentaire) :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim OB As Worksheet 'déclare la variable OB (Onglet Base)
Dim CA As Range 'déclare la variable CA (Cellule Active)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Integer 'déclare la variable NL (Nombre de Lignes)
Dim NC As Integer 'déclare la variable NC (Nombre de Colonnes)
Dim i As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set CA = ActiveCell 'définit la cellule CA
Set OB = Worksheets("Base") 'définit l'onglet OB
TV = OB.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de ligne NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
For Each OD In Worksheets 'boucle sur tous les onglets OD du classeur
    If Not OD.Name = OB.Name Then 'si le nom de l'onglet de la boucle n'est pas le nom de l'onglet OB (=Base)
        OD.Cells.ClearContents 'efface le contenu de l'ongelt OD
        OB.Rows(1).Copy 'copie la ligne 1 de l'ongle OB
        OD.Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes dans l'onglet OD
        OB.Rows(1).Copy OD.Range("A1") 'copie la ligne 1 de l'ongle OB dans la cellule A1 de l'onglet OD
        OD.Activate 'active l'onglet OD
        OD.Range("A1").Select 'sélectionne la cellule A1 de l'onglet OD
    End If 'fin de la condition
Next OD 'prochain onglet de la boucle
For i = 2 To NL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe a la ligne suivante)
    If TV(i, 14) <> "" Then Set OD = Worksheets(TV(i, 14)) 'définit l'onglet destination si la donnée n'est pas vide (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
        ActiveSheet.Name = TV(i, 14) 'renomme l'onglet
        Set OD = ActiveSheet 'définit l'onglet OD
        OB.Rows(1).Copy 'copy la ligne 1 de l'ongle OB
        OD.Range("A1").PasteSpecial (xlPasteColumnWidths) 'colle la largeur des colonnes dans l'onglet OD
        OB.Rows(1).Copy OD.Range("A1") 'copy la ligne 1 de l'ongle OB dans la cellule A1 de l'onglet OD
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
    DEST.Resize(1, NC).Value = Application.Index(TV, i) 'renvoie dans DEST redimensionné la ligne I du tableau des valeurs TV
Next i 'prochaine ligne de la boucle
OB.Activate 'active l'onglet OB
CA.Select 'sélectionne la cellule active CA
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Pour information la ligne qui bloque est celle-ci :

Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)

J'ai essayé une macro pour créer une ligne, une macro pour couper l'ensemble du tableau et le faire glisser d'une ligne etc mais rien n'y fait. Je pense c'est du a la destination, la création de ligne ou le déplacement vers le bas d'une ligne de la base de données ne plait pas au code.

Auriez-vous une solution à mon souci? Car j'ai beau chercher je rame complétement. Merci d'avance

Change cette ligne avec

Set DEST = OD.Cells(OD.Rows.Count, "A").End(xlUp).Offset(1, 0)

Bonjour m3ellem1,

Merci pour ta réponse, j'ai fait le remplacement et j'ai toujours le même souci.

Voici quelques imprime écran pour vous données une idées. D'ailleurs sur la 3eme photo c'est bizarre qu'il y ai une ligne sans commercial attribué alors qu'on est dans la feuille du commercial "PS" :s