Formulaire saisie de données - Écrase toujours la ligne malgré le code

Bonjour,

J'ai monté 4 formulaires de base me permettant de regrouper des données dans un tableau que je pourrais par la suite questionner. Sur 4 formulaires, 2 fonctionne très bien et 2 ne fonctionnent pas. Pourtant ils sont tous faits exactement de la même façon ?

J'ai monté le formulaire et la base de données pour qu'à chaque fois que j'ajoute un nouvel enregistrement au formulaire, il y ai une nouvelle ligne de créer dans la base de données. Mon problème est que j'arrive à entrer une ligne dans ma ba se données, une deuxième aussi. Par contre aussitôt que j'en ajoute une troisième, celle-ci écrase la deuxième...

Quelqu'un peux me donner un coup de main à régler le problème s.v.p.?

Merci à l'avance pour votre aides!

'*****************************************************************

'Procédure permettant d'ajouter un nouvel enregistrement

'*****************************************************************

Private Sub btnAjout_Click()

Sheets("Inspection").Activate

Range("A2").Select

Selection.End(xlDown).Select 'On se positionne sur la dernière ligne non vide

Selection.Offset(1, 0).Select 'On se décalle d'une ligne vers le bas

ActiveCell = txtDate.Value

ActiveCell.Offset(0, 1).Value = txtBT

ActiveCell.Offset(0, 2).Value = txtInfoProduit

ActiveCell.Offset(0, 3).Value = txtInfoBT

ActiveCell.Offset(0, 4).Value = txtLot

ActiveCell.Offset(0, 5).Value = cboCodagelisible1

ActiveCell.Offset(0, 6).Value = cboCodagelisible2

ActiveCell.Offset(0, 7).Value = cboCodagelisible3

ActiveCell.Offset(0, 8).Value = cboCodagebouteilleBT1

ActiveCell.Offset(0, 9).Value = cboCodagebouteilleBT2

ActiveCell.Offset(0, 10).Value = cboCodagebouteilleBT3

ActiveCell.Offset(0, 11).Value = cboCodagecaisselisible1

ActiveCell.Offset(0, 12).Value = cboCodagecaisselisible2

ActiveCell.Offset(0, 13).Value = cboCodagecaisselisible3

ActiveCell.Offset(0, 14).Value = cboCodagecaisseBT1

ActiveCell.Offset(0, 15).Value = cboCodagecaisseBT2

ActiveCell.Offset(0, 16).Value = cboCodagecaisseBT3

ActiveCell.Offset(0, 17).Value = cboBouchon1

ActiveCell.Offset(0, 18).Value = cboBouchon2

ActiveCell.Offset(0, 19).Value = cboBouchon3

ActiveCell.Offset(0, 20).Value = cboSiropbouteille1

ActiveCell.Offset(0, 21).Value = cboSiropbouteille2

ActiveCell.Offset(0, 22).Value = cboSiropbouteille3

ActiveCell.Offset(0, 23).Value = cboSiropfilets1

ActiveCell.Offset(0, 24).Value = cboSiropfilets2

ActiveCell.Offset(0, 25).Value = cboSiropfilets3

ActiveCell.Offset(0, 26).Value = cboTemperature1

ActiveCell.Offset(0, 27).Value = cboTemperature2

ActiveCell.Offset(0, 28).Value = cboTemperature3

ActiveCell.Offset(0, 29).Value = cboBPF

ActiveCell.Offset(0, 30).Value = txtDetail6

ActiveCell.Offset(0, 31).Value = cboEnvironnement

ActiveCell.Offset(0, 32).Value = txtDetail7

ActiveCell.Offset(0, 33).Value = cboFormulaireBienRempli

ActiveCell.Offset(0, 34).Value = txtDetail8

ActiveCell.Offset(0, 35).Value = txtCommentaire

ActiveCell.Offset(0, 36).Value = txtInitiale

MsgBox "L'inspection a bien été ajouté à la base de données", vbOKOnly + vbInformation, "CONFIRMATION"

End Sub

Bonjour,

Un souci, la méthode pour ajouter une ligne au tableau avant d'y inscrire les données.

Pour une autre feuille, il suffit d'adapter le nom du tableau au besoin (2 endroits)

Essai ainsi ...

Private Sub btnAjout_Click()
Dim X As Long

    Sheets("Inspection").Activate

    Range("TEmbouteilleuse").Select    ' <<< adapter le nom du tableau au besoin
    Selection.ListObject.ListRows.Add AlwaysInsert:=True
    X = Range("TEmbouteilleuse").Rows.Count + 2 ' <<< adapter le nom du tableau au besoin

    Cells(X, "A") = txtDate.Value
    Cells(X, "A").Offset(0, 1).Value = txtBT
    Cells(X, "A").Offset(0, 2).Value = txtInfoProduit
    Cells(X, "A").Offset(0, 3).Value = txtInfoBT
    Cells(X, "A").Offset(0, 4).Value = txtLot
    Cells(X, "A").Offset(0, 5).Value = cboCodagelisible1
    Cells(X, "A").Offset(0, 6).Value = cboCodagelisible2
    Cells(X, "A").Offset(0, 7).Value = cboCodagelisible3
    Cells(X, "A").Offset(0, 8).Value = cboCodagebouteilleBT1
    Cells(X, "A").Offset(0, 9).Value = cboCodagebouteilleBT2
    Cells(X, "A").Offset(0, 10).Value = cboCodagebouteilleBT3
    Cells(X, "A").Offset(0, 11).Value = cboCodagecaisselisible1
    Cells(X, "A").Offset(0, 12).Value = cboCodagecaisselisible2
    Cells(X, "A").Offset(0, 13).Value = cboCodagecaisselisible3
    Cells(X, "A").Offset(0, 14).Value = cboCodagecaisseBT1
    Cells(X, "A").Offset(0, 15).Value = cboCodagecaisseBT2
    Cells(X, "A").Offset(0, 16).Value = cboCodagecaisseBT3
    Cells(X, "A").Offset(0, 17).Value = cboBouchon1
    Cells(X, "A").Offset(0, 18).Value = cboBouchon2
    Cells(X, "A").Offset(0, 19).Value = cboBouchon3
    Cells(X, "A").Offset(0, 20).Value = cboSiropbouteille1
    Cells(X, "A").Offset(0, 21).Value = cboSiropbouteille2
    Cells(X, "A").Offset(0, 22).Value = cboSiropbouteille3
    Cells(X, "A").Offset(0, 23).Value = cboSiropfilets1
    Cells(X, "A").Offset(0, 24).Value = cboSiropfilets2
    Cells(X, "A").Offset(0, 25).Value = cboSiropfilets3
    Cells(X, "A").Offset(0, 26).Value = cboTemperature1
    Cells(X, "A").Offset(0, 27).Value = cboTemperature2
    Cells(X, "A").Offset(0, 28).Value = cboTemperature3
    Cells(X, "A").Offset(0, 29).Value = cboBPF
    Cells(X, "A").Offset(0, 30).Value = txtDetail6
    Cells(X, "A").Offset(0, 31).Value = cboEnvironnement
    Cells(X, "A").Offset(0, 32).Value = txtDetail7
    Cells(X, "A").Offset(0, 33).Value = cboFormulaireBienRempli
    Cells(X, "A").Offset(0, 34).Value = txtDetail8
    Cells(X, "A").Offset(0, 35).Value = txtCommentaire
    Cells(X, "A").Offset(0, 36).Value = txtInitiale

    MsgBox "L'inspection a bien été ajouté à la base de données", vbOKOnly + vbInformation, "CONFIRMATION"

End Sub

ric

Merci beaucoup !! Ça fonctionne maintenant avec votre aides !

Bonjour a tous a propos j'ai aussi le même problème pouvez vous m'aider svp

j'ai crée un formulaire mais a chaque que j'essai d'ajouter il écrase la précédente.

Sub ajouter_entre()

'

'ajouter_entree macro

'

'

Sheets("Formulaire").Range("B3:H3").Select

Selection.Copy

Sheets("ENTR_STK").Select

Range("B2").End(xlDown).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

Sheets("Formulaire").Select

Range("c6").Select

Application.CutCopyMode = False

Selection.ClearContents

Range("e6").Select

Selection.ClearContents

Range("g6").Select

Selection.ClearContents

Range("c11").Select

Selection.ClearContents

Range("e11").Select

Selection.ClearContents

Range("c15").Select

Selection.ClearContents

Range("e15").Select

Selection.ClearContents

Range("d20").Select

End Sub

Bonjour lyes5317,

Il serait plus respectueux d'ouvrir ta propre demande.

ric

Salut, désoler je suis nouveau je ne sais pas comment faire

je m'en excuse

Rechercher des sujets similaires à "formulaire saisie donnees ecrase ligne code"