duplication multiple de feuille

[reyval]

Bonsoir à tous,
Suite à une précédente demande sur ce même forum qui était trop floue, je souhaiterais restreindre cette demande.

J'ai une feuille excel dans un classeur (nom de la feuille: S1)
Je souhaite copier cette feuille N fois dans ce même classeur.
Le nom de ces feuilles doit être implémenté comme suit: S2; S3; S4....
Je souhaite changer sur chaque feuille le contenu d'une ou plusieurs cellules (exemple: A3=01/01/11 pour S1, A3=01/01/11+7 pour S2, A3=01/01/11+14 pour S3 ...)

Avez vous une idée sur le code vba qu'il faut pour faire ceci?

Merci d'avance pour votre aide.

Slts,

 

[mromain]

Re : duplication multiple de feuille

Bonsoir reyval,

Voici un essai.
Par contre, il faut que le classeur contienne déjà la feuille S1 avec une date en A3.

Sub CreerFeuille()
Dim numSem As Long, laFeuille As Worksheet
    
    '-- récupérer le numéro de la semaine (pour nommer la nouvelle feuille
    'initialiser la variable numSem
    numSem = 0
    'boucler sur chaque feuille du classeur
    For Each laFeuille In ThisWorkbook.Sheets
        'si il s'agit d'une "feuille semaine" (dont le nom est de la forme "S**"
        If IsNumeric(Replace(laFeuille.Name, "S", "")) Then
            'si le numéro de la feuille est > à la variable numSem, le mémoriser dans numSem
            If numSem < CLng(Replace(laFeuille.Name, "S", "")) Then numSem = CLng(Replace(laFeuille.Name, "S", ""))
        End If
    Next laFeuille
    'ajouter 1 (nouvelle semaine)
    numSem = numSem + 1
    
    With ThisWorkbook
        '-- créer la nouvelle feuille (copie de S1)
        'copier la feuille S1
        .Sheets("S1").Copy after:=.Sheets(.Sheets.Count)
        'renommer la nouvelle feuille
        .Sheets(.Sheets.Count).Name = "S" & numSem
        'la placer après la semaine précédente
        .Sheets(.Sheets.Count).Move after:=.Sheets("S" & numSem - 1)
        
        '-- modifier la valeur de la cellule A3
        .Sheets("S" & numSem).Range("A3").Value = .Sheets("S1").Range("A3").Value + (numSem - 1) * 7
    End With
End Sub

A+