Je n'arrive pas à ajouter mes données en VBA

Bonjour à toutes et tous,

lorsque j'ajoutes des nouvelles données, ces données écrasent les précédentes.

Voici mon code :

Function copy_from_form()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Données").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Données")
.Range("A" & LastRow).Value = TextBox1.Value
.Range("B" & LastRow).Value = TextBox2.Value
.Range("C" & LastRow).Value = TextBox3.Value
.Range("D" & LastRow).Value = TextBox4.Value
.Range("E" & LastRow).Value = ComboBox_Sexe.Value
.Range("F" & LastRow).Value = ComboBox1_Fiche.Value
.Range("G" & LastRow).Value = TextBox6.Value
.Range("H" & LastRow).Value = TextBox7.Value
.Range("I" & LastRow).Value = TextBox8.Value
.Range("J" & LastRow).Value = ComboBox_Categories.Value
End With
End Function

Edit modo : code à mettre entre balises avec le bouton </> merci d'y faire attention la prochaine fois

Auriez-vous une soluce ?
EN vous remerciant.

Bonjour/bonsoir,

Le problème ne vient pas de ce code qui fonctionne parfaitement. On pourrait faire la remarque que comme la fonction ne renvoie aucune valeur, on pourrait simplement remplacer Function copy_from_form par Sub copy_from_form, mais cela n'affecte pas le bon fonctionnement de ce code.

Comme la dernière ligne utilisée est déterminée par la dernière cellule contenant une valeur en colonne A, lLe problème doit venir d'une instruction qui efface le contenu de la colonne A, ou la dernière ligne contenant des données n'a pas de valeur en colonne A, parce que textbox1 ne contenait aucune valeur.

Bonsoir tous le monde, et NulEnVba_13

Comme h2so l'as dis

La fonction que tu as partagée, qui copie les données à partir de plusieurs contrôles (TextBox et ComboBox) et les colle dans la feuille "Données". Cependant, elle est actuellement définie comme une fonction, ce qui signifie qu'elle ne s'exécutera pas automatiquement. C'est pour cela qu'il faut mettre sub au lieu de Function et mettre End Sub au lieu End Function

Si tu as un soucis après ça, avec un fichier, on pourrais le passer à la loupe.

Et n'oublie pas de mettre ton code dans une balise comme ceci

Sub CopyFromForm()
    Dim LastRow As Long
    LastRow = ActiveWorkbook.Sheets("Données").Range("A1000000").End(xlUp).Row
    LastRow = LastRow + 1
    With ActiveWorkbook.Sheets("Données")
        .Range("A" & LastRow).Value = TextBox1.Value
        .Range("B" & LastRow).Value = TextBox2.Value
        .Range("C" & LastRow).Value = TextBox3.Value
        .Range("D" & LastRow).Value = TextBox4.Value
        .Range("E" & LastRow).Value = ComboBox_Sexe.Value
        .Range("F" & LastRow).Value = ComboBox1_Fiche.Value
        .Range("G" & LastRow).Value = TextBox6.Value
        .Range("H" & LastRow).Value = TextBox7.Value
        .Range("I" & LastRow).Value = TextBox8.Value
        .Range("J" & LastRow).Value = ComboBox_Categories.Value
    End With
End Sub

Bonjour à tous les 2 et merci aussi à vous pour vos réponses.
Après avoir effectué un test avec "Sub" au lieu de "Fonction", j'écrase toujours ma ligne.

Je vous envoie le code complet, au cas ou.
Encore merci à vous.
Cordialement.

'Fonction ajouter
Sub CopyFromForm()
    Dim LastRow As Long
    LastRow = ActiveWorkbook.Sheets("Données").Range("A1000000").End(xlUp).Row
    LastRow = LastRow + 1
    With ActiveWorkbook.Sheets("Données")
        .Range("A" & LastRow).Value = TextBox1.Value
        .Range("B" & LastRow).Value = TextBox2.Value
        .Range("C" & LastRow).Value = TextBox3.Value
        .Range("D" & LastRow).Value = TextBox4.Value
        .Range("E" & LastRow).Value = ComboBox_Sexe.Value
        .Range("F" & LastRow).Value = ComboBox1_Fiche.Value
        .Range("G" & LastRow).Value = TextBox6.Value
        .Range("H" & LastRow).Value = TextBox7.Value
        .Range("I" & LastRow).Value = TextBox8.Value
        .Range("J" & LastRow).Value = ComboBox_Categories.Value
    End With
End Sub

Private Sub CommandButton1_Click()
Call CopyFromForm
End Sub
'Mettre une valeur dans une TextBox''Le test fonctionne'
Private Sub ComboBox_Categories_Change()
With Sheets("Base")
    TextBox44 = .Cells(ComboBox_Categories.ListIndex + 8, 8)
End With
End Sub

Private Sub UserForm_Initialize() 'Permet d'initialiser les valeurs dans les zones souhaitées

Dim H As Integer
With Sheets("Base")
For H = 8 To .Range("a65536").End(xlUp).Row
zone_nom.AddItem .Range("a" & H).Value
Next H
End With

End Sub
'Fin du chapitre de test' 'Le test fonctionne'

'Fonction Rechercher
Function search_from_form()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox2.Value
ActiveWorkbook.Sheets("Données").Activate
Set rng1 = Sheets("Données").Range("B:B").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
TextBox1.Value = Sheets("Données").Range("A" & row_number).Value
TextBox2.Value = Sheets("Données").Range("B" & row_number).Value
TextBox3.Value = Sheets("Données").Range("C" & row_number).Value
TextBox4.Value = Sheets("Données").Range("D" & row_number).Value
ComboBox_Sexe.Value = Sheets("Données").Range("E" & row_number).Value
TextBox6.Value = Sheets("Données").Range("F" & row_number).Value
TextBox7.Value = Sheets("Données").Range("G" & row_number).Value
TextBox8.Value = Sheets("Données").Range("H" & row_number).Value
ComboBox_Categories.Value = Sheets("Données").Range("I" & row_number).Value
Else
MsgBox str_search & "Not Found"
End If
End Function
Private Sub CommandButton2_Click()
Call search_from_form
End Sub

'Suppression dans la Données
Function delete_from_form_without_confirmation()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Données").Activate
Set rng1 = Sheets("Données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("Données").Rows(row_number).EntireRow.Delete
End If
End Function
Private Sub CommandButton3_Click()
Call delete_from_form_without_confirmation
End Sub

'Fonction Reinitialiser
Function reset_all_controls()
Dim ctl As MSForms.Control
For Each ctl In Me.Controls
Select Case TypeName(ctl)
Case "TextBox"
ctl.Text = ""
Case "CheckBox", "OptionButton", "ToggleButton"
ctl.Value = False
Case "ComboBox", "ListBox"
ctl.ListIndex = -1
End Select
Next ctl
End Function

Private Sub CommandButton7_Click()
Call reset_all_controls
End Sub

'Suppression dans Onglet Données
Function delete_from_form_without_confirmation_données()
Dim rng1 As Range
Dim str_search As String
str_search = TextBox1.Value
ActiveWorkbook.Sheets("Données").Activate
Set rng1 = Sheets("Données").Range("A:A").Find(str_search, , xlValues, xlWhole)
If Not rng1 Is Nothing Then
rng1.Select
Dim row_number As Long
row_number = ActiveCell.Row
ActiveWorkbook.Sheets("Données").Rows(row_number).EntireRow.Delete
End If
End Function

'AJOUT MERE
Function copy_from_form_mere()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Mere").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Mere")
.Range("A" & LastRow).Value = TextBox34.Value
.Range("B" & LastRow).Value = TextBox35.Value
.Range("C" & LastRow).Value = TextBox36.Value
.Range("D" & LastRow).Value = TextBox37.Value
.Range("E" & LastRow).Value = TextBox38.Value
End With
End Function
Private Sub CommandButton5_Click()
Call copy_from_form_mere
End Sub

'AJOUT PERE
Function copy_from_form_pere()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Pere").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Pere")
.Range("A" & LastRow).Value = TextBox11.Value
.Range("B" & LastRow).Value = TextBox13.Value
.Range("C" & LastRow).Value = TextBox39.Value
.Range("D" & LastRow).Value = TextBox40.Value
.Range("E" & LastRow).Value = TextBox41.Value
End With
End Function
Private Sub CommandButton4_Click()
Call copy_from_form_pere
End Sub

'AJOUT Règlement
Function copy_from_form_Reglement()
Dim LastRow As Long
LastRow = ActiveWorkbook.Sheets("Règlement").Range("A1000000").End(xlUp).Row
LastRow = LastRow + 1
With ActiveWorkbook.Sheets("Règlement")
.Range("A" & LastRow).Value = TextBox42.Value
.Range("B" & LastRow).Value = TextBox21.Value
.Range("C" & LastRow).Value = TextBox22.Value
.Range("D" & LastRow).Value = TextBox23.Value
.Range("E" & LastRow).Value = TextBox24.Value
.Range("F" & LastRow).Value = TextBox25.Value
.Range("G" & LastRow).Value = TextBox28.Value
.Range("H" & LastRow).Value = TextBox29.Value
.Range("I" & LastRow).Value = TextBox30.Value
.Range("J" & LastRow).Value = TextBox44.Value
.Range("K" & LastRow).Value = TextBox31.Value
.Range("L" & LastRow).Value = TextBox43.Value
End With
End Function
Private Sub CommandButton6_Click()
Call copy_from_form_Reglement
End Sub

Private Sub CommandButton8_Click()
Unload Me
End Sub

bonjour,

malheureusement le code ne (me) permet pas de confirmer la cause du problème. Il faudrait que tu mettes le fichier, - anonymisé si nécessaire -, avec les formulaires.

Merci à toi H2so4,

pourrais-tu me dire la procédure pour "anonymisé ?

Bonjour NulEnVba_13 et le forum
Essaie de modifier LastRow comme ceci

LastRow = ActiveWorkbook.Sheets("Données").Range("A" & .Rows.Count).End(xlUp).Row + 1

Cdt
Papy Henri

Bonsoir PapyHenri,

désolé mais j'ai une erreur :

"Référence incorrecte ou non qualifiée"

LastRow = ActiveWorkbook.Sheets("Données").Range("A" & .Rows.Count).End(xlUp).Row + 1

Bonsoir tous le monde le mieux c'est d'anonymiser ton fichier avec le lien sinon on y est encore a Noel Lien Anonymiser fichier

Voici le fichier en question.
Encore merci à vous.

bonjour le fil,

c'est mieux de partager un fichier, on est aveugle !!! Mais je pense que vous pouvez simplifier votre fichier, il y a beaucoup de doublons, des commandbuttons qui ne font pas grand chose, etc

Functions vos donnent une valeurs, sub font quelque chose, à mon avis, tous vos fonctions sont des subs

Public aMesDonnées
' aMesDonnées = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, TextBox4.Value, ComboBox_Sexe.Value, ComboBox1_Fiche.Value, TextBox6.Value, TextBox7.Value, TextBox8.Value, ComboBox_Categories.Value)

'Fonction ajouter
Sub CopyFromForm(NomFeuille)
     With Sheets(NomFeuille).Range("A" & Rows.Count).End(xlUp).Offset(1)
          .Resize(, UBound(aMesDonnées) + 1) = aMesDonnées
     End With
End Sub

Private Sub CommandButton1_Click()
     Call CopyFromForm
End Sub
'Mettre une valeur dans une TextBox''Le test fonctionne'
Private Sub ComboBox_Categories_Change()
     With Sheets("Base")
          TextBox44 = .Cells(ComboBox_Categories.ListIndex + 8, 8)
     End With
End Sub

Private Sub UserForm_Initialize()            'Permet d'initialiser les valeurs dans les zones souhaitées

     Dim H     As Integer
     With Sheets("Base")
          For H = 8 To .Range("a65536").End(xlUp).Row
               zone_nom.AddItem .Range("a" & H).Value
          Next H
     End With

End Sub
'Fin du chapitre de test' 'Le test fonctionne'

'Fonction Rechercher
Function search_from_form()
     Dim rng1  As Range
     Dim str_search As String
     str_search = TextBox2.Value
     ActiveWorkbook.Sheets("Données").Activate
     Set rng1 = Sheets("Données").Range("B:B").Find(str_search, , xlValues, xlWhole)
     If Not rng1 Is Nothing Then
          rng1.Select
          Dim row_number As Long
          row_number = ActiveCell.Row
          TextBox1.Value = Sheets("Données").Range("A" & row_number).Value
          TextBox2.Value = Sheets("Données").Range("B" & row_number).Value
          TextBox3.Value = Sheets("Données").Range("C" & row_number).Value
          TextBox4.Value = Sheets("Données").Range("D" & row_number).Value
          ComboBox_Sexe.Value = Sheets("Données").Range("E" & row_number).Value
          TextBox6.Value = Sheets("Données").Range("F" & row_number).Value
          TextBox7.Value = Sheets("Données").Range("G" & row_number).Value
          TextBox8.Value = Sheets("Données").Range("H" & row_number).Value
          ComboBox_Categories.Value = Sheets("Données").Range("I" & row_number).Value
     Else
          MsgBox str_search & "Not Found"
     End If
End Function
Private Sub CommandButton2_Click()
     Call search_from_form
End Sub

Private Sub CommandButton3_Click()
     Call delete_from_form_without_confirmation
End Sub

'Fonction Reinitialiser
Sub reset_all_controls()
     Dim ctl   As MSForms.Control
     For Each ctl In Me.Controls
          Select Case TypeName(ctl)
               Case "TextBox"
                    ctl.Text = ""
               Case "CheckBox", "OptionButton", "ToggleButton"
                    ctl.Value = False
               Case "ComboBox", "ListBox"
                    ctl.ListIndex = -1
          End Select
     Next ctl
End Sub

Private Sub CommandButton7_Click()
     Call reset_all_controls
End Sub

'Suppression dans Onglet Données
Sub delete_from_form_without_confirmation_données()
     Dim rng1  As Range
     Set rng1 = Sheets("Données").Range("A:A").Find(TextBox1.Value, , xlValues, xlWhole)
     If Not rng1 Is Nothing Then rng1.EntireRow.Delete
End Sub

'AJOUT MERE
Sub copy_from_form_mere()
     aMesDonnées = Array(TextBox34.Value, TextBox35.Value, TextBox36.Value, TextBox37.Value, TextBox38.Value)     'array avec vos données
     CopyFromForm "Mère"                     'ajouter ces données en dessous la feuille "Mère"
End Sub
Private Sub CommandButton5_Click()
     Call copy_from_form_mere
End Sub

'AJOUT PERE
Sub copy_from_form_pere()
     aMesDonnées = Array(TextBox11.Value, TextBox13.Value, TextBox39.Value, TextBox40.Value, TextBox41.Value)
     CopyFromForm "Père"                     'ajouter ces données en dessous la feuille "Père"
End Sub
Private Sub CommandButton4_Click()
     Call copy_from_form_pere
End Sub

'AJOUT Règlement
Sub copy_from_form_Reglement()
     aMesDonnées = Array(TextBox42.Value, TextBox21.Value, TextBox22.Value, TextBox23.Value, TextBox24.Value, TextBox25.Value, TextBox28.Value, TextBox29.Value, TextBox30.Value, TextBox44.Value, TextBox31.Value, TextBox43.Value)
     CopyFromForm "Règlement"                'ajouter ces données en dessous la feuille "Reglement"
End Sub
Private Sub CommandButton6_Click()
     Call copy_from_form_Reglement
End Sub

Private Sub CommandButton8_Click()
     Unload Me
End Sub

Re le fichier est vide pas de macro rien, pas de textbox, combobox

Bonsoir,

désolé, comme vous avez pû vous apercevoir, j'ai pas l'habitude :-(.
Voici le fichier complet, enfin j'espere.

Il y a le code mais pas les textbox et combobox

Bon !!! je crois que cette fois, c'est la bonne ;-)

lorsque j'ajoutes des nouvelles données, ces données écrasent les précédentes.

Il a l'air de fonctionner parfaitement quand tu ajoutes, tous les boutons ajouter, ça ajoute à la suite rien n'est supprimé ! Après il y a surement des choses a améliorer surtout sur le bouton supprimer. Et idem sur le bouton rechercher il faut remplir tous les champs+ les combo sous peine d'une erreur.

L'idéal serait de chercher juste un nom ou un mail et basta et idem pour supprimer, je dis ça je dis rien.

re,

un simplification qui n'est pas encore 100%. Je vois que pendant "recherche" les données ne se trouvent pas toujours dans les bon textboxes.

Pour la date "né", on aura encore les problèmes normaux (date américain) à contrôler, etc

Edit : à peu près ce que @stepaustras (salut) vient de dire ...

Bonjour tous le monde, je pense que comme ça ton fichier est beaucoup mieux NulEnVba_13, tous passe par la textbox en rouge pour chercher et supprimer, a voir si cela te convient. Petite astuce tu peux exporter ton Useform et l'importer dans ton fichier original et supprimer l'autre.

re, salut stepaustras,

contrôle de la date de naissance

Private Sub CommandButton1_Click()
     Dim Arr, MaDate, s, sp
     With TextBox4
          If Len(.Value) = 0 Then            'né=""
               MaDate = ""
          Else
               s = Replace(Replace(.Value, ".", "/"), "-", "/")     'si on utilise - ou ., remplacer cela par /, pour avoir le format "j/m/aa"
               sp = Split(s, "/")
               If UBound(sp) <> 2 Then MsgBox "date n'est pas correct" & vbLf & "rien sauvegardé": Exit Sub
               MaDate = CLng(DateSerial(sp(2), sp(1), sp(0)))
          End If
     End With
     Arr = Array(TextBox1.Value, TextBox2.Value, TextBox3.Value, MaDate, ComboBox_Sexe.Value, TextBox6.Value, TextBox7.Value, TextBox8.Value, ComboBox_Categories.Value, ComboBox1_Fiche.Value)
     Ajouter_Ligne "Données", Arr
End Sub

re, supprimer sans cette Function delete_from_form_without_confirmation_données()

Private Sub CommandButton3_Click()
     Dim rng1  As Range
     With TextBox2
          If .Value = "" Then
               MsgBox "nom inconnu": Exit Sub
          Else
               Set rng1 = Sheets("Données").Range("B:B").Find(TextBox2.Value, , xlValues, xlWhole)
               If Not rng1 Is Nothing Then
                    If vbYes = MsgBox("Voulez-vous vraiment supprimer la ligne correspondante avec le contenu : " & .Value & " ?", vbYesNo + vbQuestion, "Confirmation de suppression") Then
                         rng1.EntireRow.Delete
                    Else
                         MsgBox "Suppression annulée.", vbInformation, "Information"
                    End If
               Else
                    MsgBox .Value & " non trouvé", vbInformation, "Information"
               End If
          End If
     End With
End Sub