XL 2019 Détecter les valeurs suivant les tableaux sélectionnés et, si elles sont non-existantes, les copier

[Amigo]

Bonjour le Forum
J’utilise un fichier contenant plusieurs tableaux. Mon souhait est de dupliquer une ligne d’un tableau dans d’autres tableaux. Ces tableaux seront sélectionnés à l’aide de cases à cocher dans un Userform qui s’ouvre lorsque l’on clique sur le bouton “Dupliquer” (voir fichier ci-joint).
Si je souhaite copier une ligne du tableau_2024 dans les tableaux 2025 et 2026 :

1. Si les valeurs existent dans 2025, afficher le message “Personne existe” et passer au tableau suivant.
2. Si les valeurs existent dans le tableau 2025 mais pas dans le tableau 2026, afficher le message “Personne existe” et copier la ligne dans 2026.
3. Si les valeurs n’existent ni dans 2025 ni dans 2026, copier la ligne dans les tableaux sélectionnés."

Merci par avance
Amigo

Private Sub CommandButton1_Click()
Dim mnom As String, mprenom As String
  If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then
    For i = 0 To Me.Source.ListCount - 1
        If Me.Source.Selected(i) = True Then
            NomTableau = "Tableau" & Me.Source.List(i)
            On Error Resume Next
            mnom = Range(NomTableau & "[Nom]").Find(Me.TextBox1, LookIn:=xlValues)
            mprenom = Range(NomTableau & "[Prénom]").Find(Me.TextBox2, LookIn:=xlValues)
                If Trim(UCase(mnom)) = Trim(UCase(Me.TextBox1)) And Trim(UCase(mprenom)) = Trim(UCase(Me.TextBox2)) Then
                    MsgBox MsgBox(Me.TextBox2 & " " & Me.TextBox1 & " existe déjà dans " & NomTableau & vbCr & "Répéter Dupliquer")
'                    Unload Me
'                    Exit Sub
 
                Else

                    NomTableau = "Tableau" & Me.Source.List(i) 'temp
                    NbCol = Range(NomTableau).Columns.Count
                    If RechIntuit.TextBox1 <> "" Then
                        RechIntuit.Enreg = Range(NomTableau).Rows.Count + 1
                        Mode = "Consult"
                           For c = 1 To NbCol
                            If Not Range(NomTableau).Item(RechIntuit.Enreg, c).HasFormula Then
                              tmp = RechIntuit("textbox" & c)
                              If IsNumeric(Replace(tmp, ".", ",")) And InStr(tmp, " ") = 0 Then
                                 tmp = Replace(tmp, ".", ",")
                                 Range(NomTableau).Item(RechIntuit.Enreg, c) = CDbl(tmp)
                              Else
                                  If IsDate(tmp) Then
                                    Range(NomTableau).Item(RechIntuit.Enreg, c) = CDate(tmp)
                                  Else
                                    Range(NomTableau).Item(RechIntuit.Enreg, c) = tmp
                                  End If
                              End If
                             Else
                              Range(NomTableau).Item(RechIntuit.Enreg - 1, c).Copy
                              Range(NomTableau).Item(RechIntuit.Enreg, c).PasteSpecial Paste:=xlPasteFormats
                           End If
                         Next c
                           Range(NomTableau).Sort key1:=Range(NomTableau & "[nom]"), Header:=xlYes, Order1:=xlAscending
                 
                    End If

                End If
        End If
     Next i
  End If
Unload Me
End Sub

 

[Oneida]

Tout a fait Thierry, mais y a pas le tableau que vous avez choisi dans l'UF RechIntuit pour vos manips pour recuperer les donnees
Je suppose(itoire) que le choix se fait par un click sur une ligne de la listbox RechIntuit sinon j'espere que vous avez la memoire de 10 elephants

 

[Amigo]

Tout a fait Thierry, mais y a pas le tableau que vous avez choisi dans l'UF RechIntuit pour vos manips pour recuperer les donnees
Je suppose(itoire) que le choix se fait par un click sur une ligne de la listbox RechIntuit sinon j'espere que vous avez la memoire de 10 elephants

Re
effectivement je recherche d'abord le nom puis je le selectionne dans la listbox
Cordialement

 

[Oneida]

Bien,
Je regarde la chose
Nous sommes d'accord qu'il n'y a que les tableaux selectionnes dans l'Userform1 a mettre a jour?

 

[Oneida]

Re,

Votre code s'execute sans probleme a partir du moment ou un nom et prenom sont presents dans les txtbox 1 et 2 RechIntuit.
Comprends pas ce que vous avez comme probleme pour ce cas
Par contre en cas de modif d'une ligne d'un tableau, il faut dupliquer et ensuite supprimer l'enregistrement dans les autres tableaux selectionner en Userform1 a condition de s'en rappeler

 

[Amigo]

Re,

Votre code s'execute sans probleme a partir du moment ou un nom et prenom sont presents dans les txtbox 1 et 2 RechIntuit.
Comprends pas ce que vous avez comme probleme pour ce cas
Par contre en cas de modif d'une ligne d'un tableau, il faut dupliquer et ensuite supprimer l'enregistrement dans les autres tableaux selectionner en Userform1 a condition de s'en rappeler

Re Oneida et le forum
Faites un essai.

1. Tout d’abord, supprimez l’enregistrement “Balu” du tableau 2026 et conservez-le dans les tableaux 2024 et 2025.
2. Ensuite, choisissez le tableau 2025 et la ligne correspondant à “Balu”.
3. Dupliquez cette ligne dans les tableaux 2024 et 2026.

Le code indiquera que Balu existe dans 2024, ce qui est vrai, mais il indiquera également qu’il existe dans 2026, ce qui est faux, et il ne l’écrira pas dans ce dernier tableau.
Cordialement

 

[Oneida]

Bonjour,
3. Comment voulez vous dupliquer une ligne qui n'existe plus!

Je viens de faire l'essai et en effet probleme.
Vous auriez donne cette exemple, j'aurai fait les modif plus tot vu que le fait d'ajout ne pose aucun probleme
Je regarde la chose mais pas ce matin

Suite:
J'ai ajoute une colonne en fin des tableaux pour avoir Nom et Prenom pour faire la recherche vu qu'il y aura des noms identiques et prenom different
Fait un peu a l'arrache pour colonne ajoutee et le code pour remplir la cellule de la colonne

Procedures modifiees:
RechIntuit Private Sub B_valid_Click()
Userform1 Private Sub CommandButton1_Click()
Ajoute une subroutine pour ajout ligne Sub Ajout_Ligne(NomTableau)

 

[Amigo]

Bonsoir Oneida et le Forum
Merci pour votre réponse.
Je testerai le fichier et ne manquerai pas de revenir vers vous.
Cordialement

 

[Amigo]

Bonjour Oneida et le Forum
D’abord, je m’excuse de répondre un peu tard. La semaine était trop chargée.
Le fichier semble bien fonctionner.
Merci beaucoup.
Cependant, par curiosité, j’aimerais comprendre pourquoi mon code ne fonctionne pas.
Bon week-end !
Cordialement.

 

[Oneida]

Bonjour,
Mettez le

On Error Resume Next

en commentaire pour voir l'erreur si le Find nom n'est pas dans la colonne Nom du tableau de recherche

j'ai simplifie et reorganise le code pour la rechecher en utilisant Application.Countif pour savoir si le nom_pernom existe ou pas dans la colonne nom_prenom que j'ai ajoute dans chaque tableau et palier au nom identique et prenom different

la majorite des personne utilisent ceci pour les recherches

Dim mnom As Range
            Set mnom = Range(NomTableau & "[Nom]").Find(Me.TextBox1, LookIn:=xlValues)
            If mnom Is Nothing Then
                MsgBox "Nok: " & NomTableau
            Else
                MsgBox "ok: " & NomTableau
            End If

Perso

Application.Countif

permet d'avoir plusieurs reponses: 0 ou un certain nombre de presence
0: existe pas
X presences: si 1 ok present, si X >1 doublon

 

[Amigo]

Bonjour Oneida et le Forum
Bonne fête des pères à tous les papas
Merci beaucoup pour votre aide et les explications.
Une dernière question : est-il possible de passer par une colonne virtuelle au lieu de la créer dans chaque tableau ?
Cordialement

 

[Oneida]

Bonjour,

Oui, mais ca revient a faire la recherche avec un nom et regarder si le prenom est le meme que celui de la ligne selectionnee dans l'userform Userform1 via userform1
Si votre fichier Excel est fait en Access, les tableau seraient des tables avec soit un champ Nom_Prenom ou un champ avec un numero Auto unique pour une recherche plus simple
Pour les tableaux Excel il est aussi interessant de faire de meme
Donc ceci explique cela
Maintenant si vous voulez je peux vous faire le code sans colonne supplementaire

 

[Amigo]

Bonsoir Oneida et le forum
Merci beaucoup pour ces explications.
Je ne voudrais pas abuser de votre gentillesse, sauf si cela ne vous dérange pas.
Cordialement

 

[Oneida]

Bonjour,
Y a pas d'lezard, je vous fais ca sans colonne sup
Combien de lignes max dans les BD?

En attendant, une facon de faire

 

[Amigo]

Bonsoir Oneida et le forum
Chaque BD comporte actuellement entre 5000 et 15000 lignes.
Merci pour le fichier. Je vais l’analyser en détail pour comprendre la méthode.
Cordialement

 

[Amigo]

Bonjour Oneida et le Forum
Merci de votre fichier qui fonctionne très bien (juste un peu lent à l’exécution avec mes BDs qui sont grandes en taille) et un grand merci pour votre implication.
J’ai aussi de mon côté continué à chercher une solution et j’en ai trouvé une que je souhaite partager avec vous et elle me semble plus rapide. ( voir code ci-après).
Encore Merci à vous et merci à ce forum d'entraide, de partage et de transmission.
Cordialement

Private Sub CommandButton1_Click()
Dim n As String, p As String, ligne As Integer
n = Me.TextBox1
p = Me.TextBox2
  If Me.Source.ListIndex <> -1 And Me.Source.ListCount > 0 Then
    For i = 0 To Me.Source.ListCount - 1
        If Me.Source.Selected(i) = True Then
            NomTableau = "Tableau" & Me.Source.List(i)
            Set mondico = CreateObject("scripting.dictionary")
            a = Range(NomTableau).Value
                lg = Range(NomTableau).Rows.Count
                For j = 1 To lg
                  mondico(a(j, 1)) = j
                Next j
                On Error Resume Next
                clé = n
                ligne = mondico(clé)
                val1 = a(ligne, 1)
                val2 = a(ligne, 2)
                   
                    Select Case ligne
                        Case Is > 0
                                If (va11 = n And val2 = p) Then
                                MsgBox (Me.TextBox2 & " " & Me.TextBox1 & " existe déjà dans " & NomTableau)
                                Else
                                reg = lg + 1
                                Range(NomTableau).Item(reg, 1) = Trim(UCase(CStr(Me.TextBox1)))
                                Range(NomTableau).Item(reg, 2) = Trim(Application.Proper(CStr(Me.TextBox2)))
                                Range(NomTableau).Sort key1:=Range(NomTableau & "[nom]"), key2:=Range(NomTableau & "[Prénom]"), Header:=xlYes, Order1:=xlAscending
                                MsgBox (Me.TextBox2 & " " & Me.TextBox1 & " a été créé dans " & NomTableau)
                                End If
                        Case Is = 0
                                reg = lg + 1
                                Range(NomTableau).Item(reg, 1) = Trim(UCase(CStr(Me.TextBox1)))
                                Range(NomTableau).Item(reg, 2) = Trim(Application.Proper(CStr(Me.TextBox2)))
                                Range(NomTableau).Sort key1:=Range(NomTableau & "[nom]"), key2:=Range(NomTableau & "[Prénom]"), Header:=xlYes, Order1:=xlAscending
                                MsgBox (Me.TextBox2 & " " & Me.TextBox1 & " a été créé dans " & NomTableau)
                    End Select

        End If
     Next i
  End If

Unload Me
End Sub