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]

Bonjour,
Le code le plus rapide est avec une colonne numero unique par ligne

 

[Amigo]

Bonjour Oneida et le Forum
Oui vous avez raison.
Je m'efforcerai à créer un code unique pour chaque produit.
il me semble que la recherche sera plus simple avec une seule clé.
Encore Merci
Cordialement

 

[Oneida]

Re,

Regardez dans le fichier que je vous ai mis post #21
FormRechercheModifAjoutSupMultiBD - V2_SWF.xlsm
C'est vraiment simple pour la recherche

 

[Amigo]

Bonjour Oneida et le Forum
Oui je l’utilise et il fonctionne très bien.
Merci beaucoup
Bon week-end