Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [C1]) Is Nothing Then
On Error Resume Next
Sheets("Inscriptions").Name = Sheets("Inscriptions").Name
If Err.Number <> 0 Then Exit Sub ' Si la feuille Inscriptions n'existe pas on sort
Application.ScreenUpdating = False
If MsgBox("Etes vous bien sur de vouloir supprimer la feuille Inscriptions ?", vbYesNo, "Titre ") = vbYes Then
Application.DisplayAlerts = False
Sheets("Inscriptions").Delete
End If
End If
Fin...
Function Feuille_Existe(Nom As String) As Boolean
Dim Sh As Object
For Each Sh In Sheets
If UCase(Sh.Name) = UCase(Nom) Then
Feuille_Existe = True
Exit For
End If
Next
End Function
Sub Supprimer_Feuille()
If Sheets("Nous").[C1] = "nous" Then
Application.DisplayAlerts = False
If Feuille_Existe("Inscriptions") Then Sheets("Inscriptions").Delete
Application.DisplayAlerts = True
End If
End Sub
Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [C1]) Is Nothing Then
On Error Resume Next
Sheets("Inscriptions").Name = Sheets("Inscriptions").Name
If Err.Number <> 0 Then Exit Sub ' Si la feuille Inscriptions n'existe pas on sort
Application.ScreenUpdating = False
If MsgBox("Etes vous bien sur de vouloir supprimer la feuille Inscriptions ?", vbYesNo, "Titre ") = vbYes Then
Application.DisplayAlerts = False
Sheets("Inscriptions").Delete
End If
End If
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Je vais tester et vous tiens au courantBonjour Berru, Phil,
Une autre approche en PJ.
La macro se déclenche automatiquement lorsqu'on modifie la valeur de Nous C1, avec :
A vous d'adapter à votre fichier, la macro se trouve dans la feuille Nous.VB:Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, [C1]) Is Nothing Then On Error Resume Next Sheets("Inscriptions").Name = Sheets("Inscriptions").Name If Err.Number <> 0 Then Exit Sub ' Si la feuille Inscriptions n'existe pas on sort Application.ScreenUpdating = False If MsgBox("Etes vous bien sur de vouloir supprimer la feuille Inscriptions ?", vbYesNo, "Titre ") = vbYes Then Application.DisplayAlerts = False Sheets("Inscriptions").Delete End If End If Fin: Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
Un grand BonjourBonjour @berru76
Je te propose ce code à mettre dans un module:
Explication:
1) On teste si C1 = nous
2) On teste si la feuille à supprimer existe si oui on supprime la feuille (On ne peux pas supprimer une feuille qui n'existe pas ou plus)
VB:Function Feuille_Existe(Nom As String) As Boolean Dim Sh As Object For Each Sh In Sheets If UCase(Sh.Name) = UCase(Nom) Then Feuille_Existe = True Exit For End If Next End Function Sub Supprimer_Feuille() If Sheets("Nous").[C1] = "nous" Then Application.DisplayAlerts = False If Feuille_Existe("Inscriptions") Then Sheets("Inscriptions").Delete Application.DisplayAlerts = True End If End Sub
Par contre je ne te propose pas de fichier car le code VBA de ton fichier est verrouillé
Regarde la pièce jointe 1142422
Je te laisse mettre un bouton pour lancer la macro "Supprimer_Feuille"
*Merci de ton retour
@Phil69970
Et bien sur après avoir copier la totalité de ma macro dans un module !!!Supprimer_Feuille
Sub Cadre1_Cliquer()
Application.ScreenUpdating = False
'*******
'La procedure de suppression de la feuille se lance ici
'elle va tester si les conditions sont ok donc If Sheets("20").[AI2] = "nous"
'Comme Sheets("20").[AI2] est vide la suppression ne se fera jamais !!!
'et supprimer la feuille si besoin
Supprimer_Feuille
'*******
Range("C4:C99").Select
Selection.Copy
Dim ws As Worksheet
a = Range("E4")
If IsError(Evaluate("='" & a & "'!A1")) Then
MsgBox "Le nombre d'équipe " & a & " ne correspond pas. Mini 20 / Maxi 96"
Exit Sub
End If
'Ici tu masques toutes les feuilles MAIS n'oublies pas qu'excel veut avoir au moins 1 feuille non masquée que tu le veuilles ou non
Call MasquerFeuilles
'Et ici tu les demasques toutes !!! MDR
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Inscriptions" Or ws.Name = "Mode d'emploi" Or ws.Name = "Noms" Or ws.Name = "" & a & "" Then
ws.Visible = xlSheetVisible
End If
Next ws
Sheets("" & a & "").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues , Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("F1").Select
End Sub
Sub Cadre1_Cliquer()
Dim ws As Worksheet, Derlig&
Supprimer_Feuille ' <== A voir si cela sert à quelque chose !!!
a = Range("E4")
If IsError(Evaluate("='" & a & "'!A1")) Then
MsgBox "Le nombre d'équipe " & a & " ne correspond pas. Mini 20 / Maxi 96"
Exit Sub
End If
Derlig = [E4]
Sheets("" & a & "").Range("C4:C" & Derlig + 3) = Sheets("Inscriptions").Range("C4:C" & Derlig + 3).Value
End Sub
Vous ne pouvez pas intégrer in extenso une macro Worksheet_Change dans une macro classique.Merci a Sylvain mais dans la macro Sub Cadre1_Cliquer() (Aller a la feuille) je n'arrive pas a l'insérer et la faire fonctionner je suis pas doué pourtant L'idée me semblait très bien aussi
'-------------------------------------------------
On Error Resume Next
Sheets("Inscriptions").Name = Sheets("Inscriptions").Name
If Err.Number <> 0 Then Exit Sub ' Si la feuille Inscriptions n'existe pas on sort
Application.ScreenUpdating = False
If MsgBox("Etes vous bien sur de vouloir supprimer la feuille Inscriptions ?", vbYesNo, "Titre ") = vbYes Then
Application.DisplayAlerts = False
Sheets("Inscriptions").Delete
End If
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Je partage les concours avec d'autres clubs
J'ai essayé de ne protéger que la feuille mais cela ne décourage pas certain et après on m'annonce un bug
au moins la je saurais si essai de modif ou pas
Tu n'as pas réussi à écrire n'importe ou dans ton code ce mot :pour Phil69970
J'ai essayé mais pas réussi a l'intégrer dans dans la formule "aller a la feuille" donc j'abandonne
Function Feuille_Existe(Nom As String) As Boolean
Dim Sh As Object
For Each Sh In Sheets
If UCase(Sh.Name) = UCase(Nom) Then
Feuille_Existe = True
Exit For
End If
Next
End Function
Sub Supprimer_Feuille()
' ==> Sheets("20").[AI2].Value est vide donc la suppression ne se fera pas, voir JAMAIS !!!!
' ==> Donc à quoi cela sert !!!!!
If Sheets("20").[AI2] = "nous" Then
Application.DisplayAlerts = False
If Feuille_Existe("Inscriptions") Then Sheets("Inscriptions").Delete
Application.DisplayAlerts = True
End If
End Sub