code ne fonctionne plus en copiant une feuille pour renommer les onglets
Bonjour,
J'utilise le code ci-dessous pour renommer les onglets des feuilles existants dans un classeur:
dans le module ThisWorkbook
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
| Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Nom As String
Dim NomUtil As String
Dim Compteur As Integer
If Not Intersect(Range("C7"), Target) Is Nothing And Target.Count = 1 Then
If Target = "" Then Exit Sub
Nom = Format(Range("c7"), "dd-mm")
NomUtil = Nom
Do While FeuilleExiste(NomUtil) = True
Compteur = Compteur + 1
NomUtil = Nom + " - " & Format(Compteur, "00")
Loop
Sh.Name = NomUtil
End If
End Sub |
dans le module standart "Module1"
Code:
1 2 3 4 5
| Function FeuilleExiste(Nom As String) As Boolean
On Error Resume Next
FeuilleExiste = Sheets(Nom).Name <> ""
On Error GoTo 0
End Function |
J'ai rajouté via un bouton sur une feuille ce code ActiveSheet.Copy after:=ActiveSheetpour copier et coller la feuille
Mais du coup le code celui qui renomme les onglets ne fonctionne plus;;
quelqu'un a une idée?
Amicalement