Créer N° dossier unique

Bonsoir,

Je cherche à créer des numéros de dossiers uniques.

Le numéro se compose comme suit, le site, le numéro du site, l'année en cours, le type du contrôle

Jusque là j'arrive à me démerder

Mon soucis est qu'il arrive que plusieurs numéros soient complètements identiques, je voudrais donc tester la colonne, et si le numéro existe déjà y ajouter "01" puis "02", "03"

Merci,

34test-n-dossier.xlsm (32.73 Ko)

Bonjour,

Code à adapter.

Option Explicit
Private Sub CommandButton2_Click()
Dim iRow As Integer, num As Integer, _
    dossier As String

    iRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    dossier = ComboBox1 & "_" & ComboBox2 & "_" & TextBox1 & "_" & ComboBox3
    num = Application.CountIf(Range("A:A"), "=*" & dossier & "*")
    If num = 0 Then
        Me.TextBox2 = dossier
    Else
        Me.TextBox2 = dossier & Format(num, "00")
    End If

    Cells(iRow, 1) = Me.TextBox2

End Sub

Bonjour Jean Éric,

Merci pour ton aide je vais tester ça.

Petite question, comment va se comporter cette macro quand il y aura 800 lignes

150 sites sont répertoriés avec diverses déclinaisons de contrôles.

Ne va t'il pas y avoir un certain temps de réponse?

Merci encore et bon week end.

J'ai essayé d'appliquer ton code sur le classeur "main courante" que j'ouvre, petit problème, le classeur "main courante" s'ouvre bien, mais les données se renseignent toujours dans le classeur "test".....

J'avoue ne pas du tout comprendre pourquoi??

Dim iRow As Integer, num As Integer, _
    dossier As String
dossier = ComboBox1 & "_" & ComboBox2 & "_" & TextBox1 & "_" & ComboBox3
   Workbooks.Open Filename:=ThisWorkbook.Path & "\main courante.xls"
    For Each W In Workbooks
        If W.Name = "main courante.xls" Then
                With Workbooks("main courante.xls").Sheets("2014")
    iRow = Range("A" & Rows.Count).End(xlUp).Row + 1
    num = Application.CountIf(Range("A:A"), "=*" & dossier & "*")
    If num = 0 Then
        Me.TextBox2 = dossier
    Else
        Me.TextBox2 = dossier & Format(num, "00")
    End If

    Cells(iRow, 1) = Me.TextBox2
            End With
            ActiveWorkbook.Save
    ActiveWorkbook.Close
            MsgBox "Main courante renseignée"
            End
        End If
    Next W
    MsgBox "Vous devez ouvrir votre classeur ''main courante'' !", 16

End Sub
Rechercher des sujets similaires à "creer dossier unique"