XL 2010 [Résolu par Bebere] Incrémenter code article selon la catégorie

Private Sub CmdSupTous_Click()
Dim sh As Worksheet, i&, k&, n&, rw&, sw&, j%
    Dim nom(), c()
    nom = Array("Produits", "Categories", "Stock", "Liste Categories")
    c = Array(4, 4, 4, 5)

    For k = LBound(nom) To UBound(nom)
        For Each sh In ActiveWorkbook.Worksheets
            With Worksheets(CStr(nom(k)))    'sh
                derlig = .Cells(Rows.Count, 4).End(xlUp).Row
                For i = derlig To 2 Step -1
                    Select Case c(k)
                    Case 4
                        If .Cells(i, 4).Value = TextBox4.Value Or .Cells(i, 1) = "" Then .Cells(i, 4).EntireRow.Delete
                    Case 5
                        If .Cells(k, 5).Value = TextBox4.Value Then .Cells(k, 5).EntireRow.Delete

                    End Select
                Next i
            End With
        Next sh
    Next k

    ListView1.ListItems.Clear

    For n = 2 To 7
        Controls("TextBox" & n) = ""
    Next n
End Sub

Private Sub CmdSupTous_Click()
Dim lig&, ligne&, derlig&, i&, k&, j&, n&, x&, rw&


On Error Resume Next

With WsProd
derlig = .Cells(.Rows.Count, 4).End(xlUp).Row
For x = derlig To 2 Step -1
If .Cells(x, 4) = CmbCategories Then .Cells(x, 1).EntireRow.Delete
Next x
ligne = .Range("a65536").End(xlUp).Row
For k = 2 To ligne
If .Cells(k, 2) <> "" Then .Cells(k, 1) = k - 1
Next k
End With

With WsStock
derlig = .Cells(.Rows.Count, 4).End(xlUp).Row
For x = derlig To 2 Step -1
If .Cells(x, 4) = CmbCategories Then .Cells(x, 1).EntireRow.Delete
Next x
.Rows.RowHeight = 12.75
ligne = .Range("a65536").End(xlUp).Row
For k = 2 To ligne
If .Cells(k, 2) <> "" Then .Cells(k, 1) = k - 1
Next k
End With

With WsCat
derlig = .Cells(.Rows.Count, 2).End(xlUp).Row
For x = derlig To 2 Step -1
If .Cells(x, 2) = CmbCategories Then .Cells(x, 1).EntireRow.Delete
Next x
ligne = .Range("a65536").End(xlUp).Row
For k = 2 To ligne
If .Cells(k, 2) <> "" Then .Cells(k, 1) = k - 1
Next k
End With

With WsLC
derlig = .Cells(.Rows.Count, 4).End(xlUp).Row
For x = derlig To 2 Step -1
If .Cells(x, 3) = CmbCategories Then .Cells(x, 1).EntireRow.Delete
Next x
ligne = .Range("a65536").End(xlUp).Row
For k = 2 To ligne
If .Cells(k, 2) <> "" Then: .Cells(k, 1) = k - 1
Next k
End With

Application.Wait (Now + TimeValue("00:00:01"))

Call ChangeCode
WsProd.Range("a2:d65536").Copy WsStock.Range("a2")

ListView1.ListItems.Clear

For n = 2 To 7
Controls("TextBox" & n) = ""
Next n
End Sub

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("k2:k65536")) Is Nothing Then
If Target.Offset(0, 0) <= 0 Then
Target.Offset(0, 1) = "A commander"
Else
Target.Offset(0, 1) = ""
End If
End If
Application.EnableEvents = True
End Sub