Copie d'une ligne après la saisie d'une valeur existante
Bonjour à tous,
Je débute en Vba, j'ai un tableau contenant plusieurs lignes et colonnes qui contiennent des formule et mise en forme conditionnelle. Je crée quotidiennement de nouvelles lignes à la suite.
Je souhaite faire une copie sous condition soit exemple :quand je saisie une valeur x dans la dernière ligne non vide /dans la colonne A de mon tableau et que cette valeur existe déjà alors une MsgBox s'ouvre et me demande si je veux copier la ligne si oui alors je copie la dernière ligne avec la même valeur en colonne A et la colle en dernière ligne de mon tableau sinon rien.
J'ai essayé de réaliser cela mais je bloque :
Private Sub Worksheet_Change(ByVal Target As
Dim Lg%, x%
Lg = Range("a65536").End(xlUp).Row
If Not Application.Intersect(Target, Range("K8:K" & Lg)) Is Nothing Then
If Application.CountIf(Range("K:K"), Target) > 1 Then
x = Application.Match(Target, Range("K:K"), 0)
If x = Target.Row Then
x = Application.Match(Target, Range(Target.Offset(1, 0), Cells(Lg, 1)), 0) + Target.Row
End If
End If
If MsgBox("Ce numéro d'article" & " " & " : " & Target.Value & " " & "existe déjà ! Copier la ligne et modifier manuellement ? ", vbYesNo + vbCritical) = vbYes Then
Target.ClearContents
Worksheets("PRA").Rows(x).Select
Worksheets("PRA").Rows(x).Copy
Worksheets("PRA").Rows(Lg).PasteSpecial
End If
End If
End Sub
Ci- dessus le code que j'ai pu récupérer sur ce site et que j'ai essayé de modifier, le code identifie bien la ligne avec la même cellule, la MsgBox s'ouvre bien mais si je clique sur oui rien ne se passe.
C'est peut-être tout bête mais je ne vois pas.
Merci d'avance pour votre aide
Cdt,
Bonjour,
Merci de joindre un fichier à ta demande.
Cdlt.
Ci-joint le fichier type de ma demande. non complet mais qui aura cette structure.
Par avance merci,
Cdt,
Bonjour à tous,
J'ai essayé de modifier mon code,
La copie de ma ligne se fait bien, hors j'ai une erreur d': "Incompatibilité de type" qui appairait.
Si quelqu'un à une petite idée pour moi, car la je bloque encore +
Par avance merci,
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dlg%, r%
dlg = Range("a65536").End(xlUp).Row
If Not Application.Intersect(Target, Range("A8:A" & dlg)) Is Nothing Then
If Application.CountIf(Range("A:A"), Target) > 1 Then
r = Application.Match(Target, Range("A:A"), 0)
End If
If r = Target.Row Then
r = Application.Match(Target, Range(Target.Offset(1, 0), Cells(dlg, 1)), 0) + Target.Row
End If
If MsgBox("La référence" & " : " & Target.Value & " à déja était saisie voulez copier sa dernière saisie", vbYesNo + vbCritical) = vbYes Then
Target.ClearContents
Sheets("feuil1").Rows(r).Copy Sheets("feuil1").Rows(dlg)
End If
End If
End Sub