Amigo
XLDnaute Occasionnel
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 :
Amigo
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 :
- Si les valeurs existent dans 2025, afficher le message “Personne existe” et passer au tableau suivant.
- 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.
- Si les valeurs n’existent ni dans 2025 ni dans 2026, copier la ligne dans les tableaux sélectionnés."
Amigo
VB:
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
Dernière édition: