Auto incrémentation Lettres + Chiffres / Loop inversé

Bonjour,

Je souhaite créer une formule qui me permet d'auto-incrémenter mes prestataire selon le type et que j'ajoute chaque nouveau prestataire en première ligne.

Au niveau de la formule elle est parfaitement opérationnelle si j'ajoute dans la dernière ligne puisque la fonction loop prend la dernière ligne comme base puis s'alimente par 1. Cependant ce que je veux moi c'est d'avoir la valeur maximale par type d'intervenant et l'alimenter par 1.

Ci après les codes d'ajout et de change
Merci bien.

Private Sub CommandButton1_Click()
Dim ws As Worksheet 'define worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")

With Sheets("Sheet1")

    .Rows("2:2").Insert Shift:=xlDown
    n = 2
    .Cells(n, "A") = TextBox2.Value
End With
Unload Me
UserForm1.Show
End Sub

Private Sub ComboBox1_Change()
'Formule d'incrémentation de la référence depuis le type de produit sélectionné
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
If UserForm1.ComboBox1 = "" Then
Exit Sub
End If

A = Left(UserForm1.ComboBox1, 2) 'Les deux premièrs lettres de type de produit

Reference = UCase(A)

derligne = ws.Cells(Rows.Count, "A").End(xlUp).Row 'Recherche dans la cellule des références
For x = 1 To derligne
    If Left(ws.Cells(x, "A"), 2) = Reference Then
    derReference = Right(ws.Cells(x, "A"), 5)
    End If
Next x
'Stop
derReference = Format(derReference + 1, "0000#") 'Choix du format de la référence 2 Lettres 5 chiffres

UserForm1.TextBox2 = Reference & "-" & derReference 'Ajout de la référence dans la case référence
End Sub

Bonjour,

Votre code modifié:

Private Sub ComboBox1_Change()
    Dim ws As Worksheet
    Dim DerLigne As Long
    Dim Reference As String, DerReference
    'Formule d'incrémentation de la référence depuis le type de produit selectionné
    Set ws = ThisWorkbook.Sheets("Sheet1")
    If UserForm1.ComboBox1 <> "" Then
        A = Left(UserForm1.ComboBox1, 2) 'Les deux premières lettres de type de produit
        Reference = UCase(A)
        DerLigne = ws.Cells(Rows.Count, "A").End(xlUp).Row 'Recherche dans la cellule des références
        If DerLigne = 1 Then DerLigne = 2
        Range("D1").FormulaR1C1 = "=IFERROR(TEXT(SUMPRODUCT((LEFT(R2C1:R" & DerLigne & "C1,2)=""" & Reference & """)*1)+1,""00000""),""00001"")"
        DerReference = Range("D1").Value
        UserForm1.TextBox2 = Reference & "-" & DerReference 'Ajout de la référence dans la case référence
        Range("D1").ClearContents
    End If
End Sub

Private Sub CommandButton1_Click()
    Dim ws As Worksheet 'definit worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With Sheets("Sheet1")
        .Rows("2:2").Insert Shift:=xlDown
        .Cells(2, "A") = TextBox2.Value
    End With
    Unload Me
    UserForm1.Show
End Sub

Cdlt

Bonjour,

ça répond parfaitement à ma demande, Merci bien,