Nom des feuilles excel automatique selon une cellule + compteur

Bonjour,
Merci pour le lien, j'y ai mis mon fichier

Bonjour,

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

ou
'mon partage
https://mon-partage.fr/

Re,

Certes, certes mais a quel moment voulez vous que ca se passe votre affaire car comprends pas trop la logique!!

Re,

Il vous faut une feuille model qui sera recopiee avec les valeurs et le nom qu'il faudra dans la chronologie. Normalement pas besoin de la feuille N°factures. Le numero de prochaine facture pourrait etre ecrit en auto dans la cellule B16 du model. Il faudra aussi un bouton ou autre action pour faire cette recopie!!

Pourquoi feuille: F201901 et ailleurs N° facture: 2019-01

La feuille FACTURATION JANVIER 2019 sera remplie comment et a quoi sert-elle??

Bonjour,

Vous restez sur votre facon de voir, allons y:

Sub Create()
    'Updateby Extendoffice 20160704
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Num_depart = ActiveSheet.Range("B16")
    Num_depart = Split(Num_depart, "-")
    Ndep = CLng(Num_depart(1))
    Set xActiveSheet = ActiveSheet
    xNumber = InputBox("Enter number of times to copy the current sheet")
    For I = Ndep To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        With ActiveSheet
            .Name = "2019-" & Format(I, "00")
            .Range("B16") = .Name
        End With
    Next I
    xActiveSheet.Activate
    Application.ScreenUpdating = True
    Set xActiveSheet = Nothing
End Sub

Il faudrait ajouter des tests sur la saisie de l'inputbox, mais a vous de voir……...

Bonjour,

Je continue de chercher une solution...

La fonction ne gère pas le compteur, elle me créée en doublon la dernière feuille.

En tout cas je te remercie pour ton aide.

Bonjour,

En effet, code modifie:

Sub Create()
    'Updateby Extendoffice 20160704
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Num_depart = ActiveSheet.Range("B16")
    Num_depart = Split(Num_depart, "-")
    Ndep = CLng(Num_depart(1)) + 1
    Set xActiveSheet = ActiveSheet
    xNumber = InputBox("Enter number of times to copy the current sheet")
    xNumber = xNumber + Ndep
    For I = Ndep To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        With ActiveSheet
            .Name = "2019-" & Format(I, "00")
            .Range("B16") = .Name
        End With
    Next I
    xActiveSheet.Activate
    Application.ScreenUpdating = True
    Set xActiveSheet = Nothing
End Sub

Bonjour,

deux feuilles au lieu d'une
Plait-il??
Chez moi si 1: creation d'une seule feuille
et ainsi de suite

Numero en fonction de B1-B70 en auto sur clic bouton, pas de problème...

Suite:
une facon de faire:

Sub Create()
    'Updateby Extendoffice 20160704
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    Dim Plage As Variant
    
    'On Error Resume Next
    'Application.ScreenUpdating = False
    With Worksheets("N°Facture")
        Plage = .Range("B1:B" & .Range("B" & Rows.Count).End(xlUp).Row)
        Nb = UBound(Plage)
    End With
    With Worksheets("Modéle")
        .Activate
        xName = .Name
    End With
    For n = 1 To Nb
        ActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        With ActiveSheet
            .Name = Plage(n, 1)
            .Range("B16") = .Name
            xName = .Name
        End With
    Next n
    xActiveSheet.Activate
    Application.ScreenUpdating = True
    Set xActiveSheet = Nothing
End Sub

Bonjour,

Si mes feuilles ne sont pas protégés, la macro me créée toutes les factures avec une dernière + 2019-70(2) et

Si mes feuilles sont protégés, ce que j'aimerai..., là ça fait une erreur d'exécution

ok j'ai trouvé pour la protection de la feuille j'ai rajouté Unprotect et Protect (ci-dessous) par contre je n'arrive pas à enlever la dernière feuille supplémentaire 2019-070 (2)

Sub MacroavecfeuilleProtect()
ActiveSheet.Unprotect "ae2c"
'Updateby Extendoffice 20160704
Dim I As Long
Dim xNumber As Integer
Dim xName As String
Dim xActiveSheet As Worksheet
Dim Plage As Variant

'On Error Resume Next
'Application.ScreenUpdating = False
With Worksheets("N°Factures")
Plage = .Range("B1:B70" & .Range("B" & Rows.Count).End(xlUp).Row)
Nb = UBound(Plage)
End With
With Worksheets("MODELE")
.Activate
xName = .Name
End With
For n = 1 To Nb
ActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
With ActiveSheet
.Name = Plage(n, 1)
.Range("B16") = .Name
xName = .Name
End With
Next n
xActiveSheet.Activate
Application.ScreenUpdating = True
Set xActiveSheet = Nothing
ActiveSheet.Protect "ae2c", True, True, True
End Sub

Re
Chez moi y a pas de feuilles protègees et ça marche sans problème!!!!!!
Pouvez mettre votre fichier à dispo??

ggrrrr ça ne me garde pas le verrouillage de ma feuille modele