super, je vais essayer. Autre chose, lorsque je créer une nouvelle recette, est-il possible que sur le menu, une fois la recette crée et qu'on revient sur le menu, de supprimer dans les case le nom de la recette et le rayon? car aujourd'hui le nom et le rayon ne s'efface pas automatiquement. Ci dessous le code:
Sub creation_nouvelle_recette()
' creation_nouvelle_recette Macro
'
Application.ScreenUpdating = False
'
nbfeuilles = ActiveWorkbook.Sheets.Count 'on compte le nombre de feuilles dans le classeur
NomRecette = Sheets("Page de garde").Range("D18") 'on récupère le nom de la recette
With Sheets("Repertoire") 'on va voir si la recette existe déjà
'fin = .Range("C" & Rows.Count).End(xlUp).Row
Set c = .Range("C8:E" & .Range("C" & .Rows.Count).End(xlUp).Row).Find(NomRecette, Lookat:=xlWhole)
If Not c Is Nothing Then
MsgBox ("cette recette existe déjà!")
Exit Sub
End If
NumLastDoc = .Range("A" & .Rows.Count).End(xlUp) 'nom du dernier doc présent dans la feuille Repertoire
End With
If NumLastDoc = "N° du document" Then
NumNewDoc = "FAB." & Range("N18") & ".01"
ElseIf CInt(Mid(NumLastDoc, 5, 2)) <> Range("N18") Then
NumNewDoc = "FAB." & Range("N18") & ".01"
Else
NumNewDoc = Left(NumLastDoc, 7) & Format(CInt(Right(NumLastDoc, 2)) + 1, "00")
End If
With Sheets("Repertoire")
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = NumNewDoc 'on ecrit le nouveau numéro en fin de liste
.Range("A" & .Rows.Count).End(xlUp).Offset(0, 1) = NomRecette 'on ecrit le nom de la recette à coté en colonne B
.Range("F" & .Range("A" & .Rows.Count).End(xlUp).Row).Resize(1, 14).Formula = "=ListeAllergènes($A" & .Range("A" & .Rows.Count).End(xlUp).Row & ")"
End With
Sheets("FAB modele").Copy After:=Worksheets(nbfeuilles) 'on copie le FAB Modele
With ActiveSheet
.Name = NumNewDoc 'on lui donne le nom avec N° de doc
.Range("H3") = NumNewDoc 'qu'on réécrit en H3
.Range("B3") = NomRecette 'et nom de la recette en B3
End With
'création du lien hypertexte
With Sheets("Repertoire")
.Activate
.Range("A" & .Rows.Count).End(xlUp).Select
.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
NumNewDoc & "!A1", TextToDisplay:=NumNewDoc
End With
Sheets(NumNewDoc).Activate
Application.ScreenUpdating = True
End Sub