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

Dadi147

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


VB:
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
 

jpb388

XLDnaute Accro
bonjour à tous,staple1600
je pense que cela vient du counta
teste ceci
VB:
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

XLDnaute Barbatruc
Supporter XLD
Bonjour @Dadi147 :), @Staple1600 ;), @jpb388 :),

Essayez ce code (non testé puisque pas de classeur joint :( ):
Code:
   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
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
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 ;))
VB:
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
 

Statistiques des forums

Discussions
303 639
Messages
2 012 824
Membres
219 428
dernier inscrit
walidizizi