Incrémenter la valeur d'une cellule d'une feuille à l'autre - VBA

Bonjour au forum,

Avec le code ci-dessous, je copie plusieurs fois la feuille "Semaine 1" en lui attribuant automatiquement le nom selon une liste prédéfinie dans la feuille "BD", colonne "C".

Le but étant de travailler sur ma feuille "Semaine 1" puis de la copier 53 fois pour avoir une feuille par numéro de semaine de l'année.

Jusque là, pas de soucis...

Là où je coince, c'est qu'à chaque copie d'une nouvelle feuille, j'aimerais ajouter +1 à la valeur de ma cellule "E6".

Sub AjouteFeuilles() '---ajout des feuilles
Dim J As Long

  Application.ScreenUpdating = False
  Set Ws = Sheets("BD")
  For J = 1 To Ws.Range("C" & Rows.Count).End(xlUp).Row
    If Not FeuilleExiste(Ws.Range("C" & J).Value) Then
      Sheets("Semaine 1").Copy after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Ws.Range("C" & J)
            Increm
        End With
    End If
  Next J
End Sub

Function FeuilleExiste(Nom As String) As Boolean '----contrôle si feuille existante
  On Error Resume Next
  FeuilleExiste = Sheets(Nom).Name <> ""
  On Error GoTo 0
End Function

Sub Increm() '-----incrémentation de la cellule E6

    For Each Ws In Worksheets
        If Ws.Name Like "Semaine*" Then
            Ws.Unprotect "mdp"
            Ws.Range("E6") = Worksheets(Ws.Index - 1).Range("E6").Value + 1
            Ws.Protect "mdp"
        End If
    Next Ws
End Sub

Ou ai-je fais faux... ?

Merci d'avance !

Bonjour,

Tu peux incrémenter à la création puisque J commence à 1 et est incrémenté de 1 à chaque passe :

Sub AjouteFeuilles() '---ajout des feuilles

    Dim J As Long

    Set Ws = Sheets("BD")

    For J = 1 To Ws.Range("C" & Rows.Count).End(xlUp).Row

        If Not FeuilleExiste(Ws.Range("C" & J).Value) Then

            Set Fe = Sheets("Semaine 1").Copy(after:=Sheets(Sheets.Count))

            With ActiveSheet

                .Range("E6").Value = J
                .Name = Ws.Range("C" & J)

            End With

        End If

    Next J

End Sub

Bonjour Thèze,

Merci pour ta réponse.

J'avais déjà testé cela mais j'ai une erreur d’exécution '1004' (Erreur définie par l'application ou par l'objet) à la ligne :

.Range("E6").Value = J

As-tu une idée ?

Question bonus : pourquoi as-tu ajouter Set Fe dans cette ligne :

Set Fe = Sheets("Semaine 1").Copy after:=Sheets(Sheets.Count)

?

Arf je suis un boulet...

J'avais simplement oublié de déprotéger la feuille avant l'incrémentation....

Mais du coup, dans un soucis d'apprentissage, j'aimerais bien quand même savoir à quoi sert le Set Fe, vu que ça fonctionne sans ?

Et autre question extra bonus mais du coup un peu hors sujet... : sais-tu s'il est réalisable d'avoir une barre de progression pour l’exécution de ce code (qui dure quand même environ 15/20 minutes... ) ?

Bonjour

Vois ce fichier .

J'ai prévu de boucler plusieurs fois, mais probablement pas assez pour toi.

Vois en fonction de ton code

A+

PS Au fait, je n'ai pas non plus compris l'intérêt du set Fe, Fe n'étant pas utilisé ensuite ???

Re,

Question bonus : pourquoi as-tu ajouter Set Fe dans cette ligne :

Juste une boulette de ma part, n'en tiens pas compte car ça ne peut pas fonctionner !

Bonjour Patty5046, Thèze, le forum,

Désolé pour le temps de réponse !

Merci Patty5046 pour ta proposition, je vais essayé d'intégrer ce code au mien.... Essayé....

Bonne semaine à vous !