Créer une Macro de saisie de données avec vérification des doublons

Bonsoir à tous,

Je viens de créer une macro pour la création d’une banque de données. Elle retranscrit des fiches papiers en listes sur Excel 2013.
Afin de faciliter l’opération de retranscription, j’ai opté pour une feuille Excel qui reproduit la mise en page de la fiche papier. Son contenu est ensuite copié en feuille 2 ‘Recueil données’ par la macro Ajouter_fiche. Ainsi les fiches sont en lignes et les variables en colonnes.

Parmi les variables, il y a le numéro de la fiche (Formulaire!C5).

J’aimerai créer un événement Worksheet_Change qui me permet de vérifier que le nombre saisie dans la case Formulaire!C5 n’est pas déjà existant dans la colonne ‘Recueil données’!A:A

Pour y parvenir j’ai trouver cette ligne de code VBA, mais je n’arrive pas à l’adapter à mon document.
La voici :

Option Explicit  
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim Colonne As Integer
Dim Adresse As String
'On sort si plus d'une cellule a été modifiée
If Target.Count > 1 Then Exit Sub
'On sort si la cellule modifiée est vide
If Target.Value = "" Then Exit Sub

'Définit la colonne à vérifier (1=Colonne A, 2=colonne B ...etc...)
Colonne = 1

'Vérifie si c'est la colonne cible a été modifiée
If Target.Column = Colonne Then

    'Recherche si la nouvelle donnée existe déjà dans la colonne.
    Adresse = Columns(Colonne).Find(What:=Target.Value, After:=Target.Offset(1, 0), LookAt:=xlWhole, _
        SearchDirection:=xlNext).Address
        
    'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
    'signifie qu'il y a un doublon dans la colonne.
    If Adresse <> Target.Address Then
    
        MsgBox "La donnée '" & Target & "' existe déjà dans la cellule " & Adresse
        'Suppression de la donnée
        Target.Value = ""
        Target.Select
    
    End If
End If
End Sub

Pouvez-vous m’éclairer svp ?

Arnaud M

Bonsoir,
avec un peu d’humour

Vu que la pile (Macro) que tu as récupérée, n’est pas compatible avec le jouet( fichier que tu doit faire fonctionner), je pense que la lumière restera éteinte; :smile:

Peut-être qu’en voyant le “joujou”, l’on pourrait trouver une adaptation de la pile :crazy_face:

Bonsoir,

Je te met la ligne de code de ma macro, ci dessous :

Sub Ajouter_fiche()
Ajouter_fiche Macro
Sheets("Recueil données").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Font.Bold = False
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
Sheets("Formulaire").Select
Range("A2").Select
Selection.Copy
Sheets("Recueil données").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("D2").Select
Sheets("Formulaire").Select
Range("D2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("E2").Select
Sheets("Formulaire").Select
Range("E2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("G2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("H2").Select
Sheets("Formulaire").Select
Range("H2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("I2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("J2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("M2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Formulaire").Select
Range("L2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("L2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("K2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("K2").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("M2").Select
Sheets("Formulaire").Select
Range("M2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("T2").Select
Sheets("Formulaire").Select
Range("N2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("N2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("O2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("O2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("P2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("P2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("R2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("R2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("S2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("S2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("T2").Select
Sheets("Formulaire").Select
Range("T2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("W2").Select
Sheets("Formulaire").Select
Range("U2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("U2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("V2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("V2").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Columns("V:V").Select
Application.CutCopyMode = False
Selection.NumberFormat = "h:mm;@"
Range("W2").Select
Sheets("Formulaire").Select
Range("W2").Select
Selection.Copy
Sheets("Recueil données").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("X2").Select
Sheets("Formulaire").Select
Range("X2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("Y2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("Y2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("Z2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("Z2").Select
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("AA2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Recueil données").Select
Range("AA2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("AB2").Select
Selection.Copy
Sheets("Recueil données").Select
Range("AB2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("AC2").Select
Selection.Copy
Sheets("Recueil données").Select
Range("AC2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Sheets("Formulaire").Select
Range("AD2").Select
Selection.Copy
Sheets("Recueil données").Select
Range("AD2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
 Sheets("Formulaire").Select
Range("AE2").Select
Selection.Copy
Sheets("Recueil données").Select
Range("AE2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("Formulaire").Select
Range("A5,C5,A9,D9,E9,F9,G9").Select
Range("G9").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range( _
    "C14,E14,F14,G14,C17,E17,F17,G17,C20,E20,F20,G20,C23,E23,F23,G23,C26,E26,F26,G26,C29,E29,G29,F32" _
    ).Select
Range("G29").Activate
Selection.ClearContents

Sheets("Formulaire").Select
Range("A5").Select
End Sub

Elle est parfaitement fonctionnelle pour la retranscription des données, je commence à paramétrer la validation des données en ce moment :slight_smile:

En ce qui concerne la pile et le jouet je reconnais être débutant en codage, pas de soucis ^^

Pour ce qui est du fichier excel tu le trouveras ici : https://1drv.ms/x/s!AnxYuYY8nG6Dga8p-qBPhqv3luxwdw?e=IEqnTd

Merci de ce que tu pourras m’apporter

Solution trouvée, il suffisait de paramétrer un contrôle des données personnalisées

La commande suivante a été utilisée : =NB.SI(‘Recueil données’!A:A;C5)=0

Bonsoir Mr @Arnaud_Mgdre
J’ai vu ton code et je vous donne un conseil pour améliorer le fonctionnement de votre code et aussi diminuer le temps d’exécution.
Éviter le maximum l’expression.select
Et désactiver le calcule automatique
Et désactiver le déplacement de l’écran Excel

Bonjour Ilies,

J’ai tenté d’alléger la macro, malheureusement cette tentative la rendue non opérationnelle…

En ce qui concerne le calcul auto et le déplacement de l’écran Excel, comment faire pour le désactiver ?

1- pour éviter l’expression.select voici un exemple
Range(“A1”).Select
Selection.Value = “Bonjour”
directement Range(“A1”).value = “Bonjour”
2- pour le calcule et le déplacement d’écran
voici un exemple

  Sub test()
           Dim..............
            Application.Calculation = xlManual 
            Application.ScreenUpdating = False

            'Code ici ...

            Application.Calculation = xlAutomatic
            Application.ScreenUpdating = True
 End sub

Par exemple
j’ai remplacer votre 3 premières lignes du code par une seuil et comme ça tu va réduire le code et l’exécution seras plus rapide

Sheets("Recueil données").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Sheets("Recueil données").Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Bonsoir Ilies,

Merci pour cet exemple, voici la macro déjà simplifiée :

Sheets(« Recueil données »).Rows(« 3:3 »).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Sheets("Formulaire").Range("A2:AE2").Select
Selection.Copy
Sheets("Recueil données").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("Formulaire").Select
Range("A5,C5,A9,D9,E9,F9,G9,C14,E14,F14,G14,C17,E17,F17,G17,C20,E20,F20,G20,C23,E23,F23,G23,C26,E26,F26,G26,C29,E29,G29,F32").Select
Selection.ClearContents

Sheets("Formulaire").Range("A5").Select

End Sub

Avec l’exemple concernant la fonction .Select , je l’ai modifié comme s’en suit :

Sheets(« Recueil données »).Rows(« 3:3 »).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

Sheets("Formulaire").Range("A2:AE2").Copy
Sheets("Recueil données").Range("A3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
Sheets("Formulaire").Range("A5,C5,A9,D9,E9,F9,G9,C14,E14,F14,G14,C17,E17,F17,G17,C20,E20,F20,G20,C23,E23,F23,G23,C26,E26,F26,G26,C29,E29,G29,F32").ClearContents

Sheets("Formulaire").Range("A5").Select

End Sub

Je la teste prochainement pour voir son bon fonctionnement :slight_smile:

Le jeu. 12 déc. 2019 à 12:02, Ilies Meziani via Forum Formule Excel contact@formuleexcel.com a écrit :

Bonjour,
A tester

Sub Ajouter_fiche()
  Sheets("Recueil données").Rows("3:3").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Selection.Font.Bold = False
    With Selection.Interior
      .Color = xlNone
    End With
  Sheets("Formulaire").Range("A2:AE2").Copy
  Sheets("Recueil données").Range("A3").PasteSpecial Paste:=xlPasteValues
  Sheets("Formulaire").Activate
  Range("A5,C5,A9,D9:G9,C14:G26,C29,E29,G29,F32").ClearContents
  Range("A5").Select
End Sub
1 « J'aime »

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.