XL 2019 problème lors de l'exécution du code vba

[Dadi147]

Bonjour, lors de l'exécution du code, il copie les nouvelles données sur les anciennes, je ne sais pas pourquoi ?

Private Sub CommandButton10_Click()
If Me.txt_product.Value = "" Then
   MsgBox "attention", vbCritical
   Exit Sub
   End If
If IsNumeric(Me.txt_price_pru) = False Then
   MsgBox "attention svp", vbCritical
   Exit Sub
   End If
   If IsNumeric(Me.txt_price_sale) = False Then
   MsgBox "attention svp", vbCritical
   Exit Sub
   End If
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("product_master")
If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then
 MsgBox "value déjà"""", vbCritical
 Exit Sub
End If
Dim lr As Integer
lr = appliction.worksheetfuncion.CountA(sh.Range("A:A"))
sh.Range("A" & lr + 1).Value = lr
sh.Range("B" & lr + 1).Value = Me.txt_product.Value
sh.Range("C" & lr + 1).Value = Me.txt_price_sale.Value
sh.Range("D" & lr + 1).Value = Me.txt_price_pru.Value

Me.txt_product.Value = ""
Me.txt_price_sale.Value = ""
Me.txt_price_pru.Value = ""
MsgBox "Done", vbtnformation

 

[Staple1600]

Bonjour le fil,

@Dadi147
Petit conseil en passant
Toujours joindre un fichier exemple simplifié et anonymisé
(notamment quand il est question d'Userform)
1) Ca nous évite de reconstruire un fichier
2) C'est plus simple pour tout le monde

 

[jpb388]

bonjour à tous,staple1600
je pense que cela vient du counta
teste ceci

Private Sub CommandButton10_Click()
    Dim lr As Integer
    If Me.txt_product.Value = "" Then Err.Raise vbObjectError + 1
    If IsNumeric(Me.txt_price_pru) = False Then Err.Raise vbObjectError + 2
    If IsNumeric(Me.txt_price_sale) = False Then Err.Raise vbObjectError + 2
    If Application.WorksheetFunction.CountIf(sh.Range("B:B"), Me.txt_product.Value) > 0 Then Err.Raise vbObjectError + 3
    lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
    sh.Range("A" & lr).Value = lr
    sh.Range("B" & lr).Value = Me.txt_product.Value
    sh.Range("C" & lr).Value = Me.txt_price_sale.Value
    sh.Range("D" & lr).Value = Me.txt_price_pru.Value
    Me.txt_product.Value = ""
    Me.txt_price_sale.Value = ""
    Me.txt_price_pru.Value = ""
    MsgBox "Done", vbtnformation
    Exit Sub
GestionErreurs:
    Select Case Err.Number
        Case vbObjectError + 1: MsgBox "attention ", vbCritical
        Case vbObjectError + 2: MsgBox "attention svp", vbCritical
        Case vbObjectError + 3: MsgBox "value déjà"""", vbCritical"
    End Select
End Sub

 

[mapomme]

Bonjour @Dadi147 , @Staple1600 , @jpb388 ,

Essayez ce code (non testé puisque pas de classeur joint ):

   Dim lr As Long
   With sh
      If .FilterMode Then .ShowAllData           'pour que le END() fonctionne correctement!
      lr = .Cells(Rows.Count, "a").End(xlUp).Row + 1
      .Cells(lr, "a") = lr - 1
      .Cells(lr, "b") = Me.txt_product
      .Cells(lr, "c") = Me.txt_price_sale
      .Cells(lr, "d") = Me.txt_price_pru
   End With

 

[Staple1600]

Bonjour le fil

@mapomme
Je me permets (le temps que mon poisson finisse de cuire)
Ou Essayez ce code (testé ,car j'ai aussi mes courgettes à cuire )

Private Sub CommandButton1_Click()
Dim lr&
   With ActiveSheet
      If .FilterMode Then .ShowAllData           'pour que le END() fonctionne correctement!
      lr = .Cells(Rows.Count, 1).End(3).Row + 1
      Cells(lr, 1).Resize(, 4) = Array(lr - 1, txt_product, txt_price_sale, txt_price_pru)
   End With
End Sub