Macro duplicante

Bonjours,

J'ai installé une macro afin que lorsque par exemple j'écris qu'il y a 3 piézomètres il me mettent 3 fiche terrains près rempli. le problème c'est que lorsque j'écris la macro sur toute mes fiches terrains crée il affiche "nombre de prestation 1" etc .

Voici la marco :

Option Explicit

Const FA = "Accueil"

Const CelPrest = "B2"

Const FM = "Modele"

Const celnuPrest = "A1"

Const FP = "Prestation n° "

Public Sub OK()

Dim nbprest As Long, nuprest As Long

nbprest = Sheets(FA).Range(CelPrest).Value

If nbprest = 0 Then Exit Sub

For nuprest = 1 To nbprest

Sheets(FM).Copy after:=Sheets(Sheets.Count)

ActiveSheet.Name = FP & nuprest

ActiveSheet.Range(celnuPrest).Value = FP & nuprest

Next nuprest

Sheets(FA).Select

End Sub

Public Sub RAZ()

Dim nbprest As Long, nuprest As Long

nbprest = Sheets.Count

If nbprest <= 2 Then Exit Sub

If MsgBox("Supprimer les feuilles Prestation", vbYesNo) = vbNo Then Exit Sub

Application.DisplayAlerts = False

For nuprest = nbprest To 1 Step -1

If InStr(1, Sheets(nuprest).Name, FP) > 0 Then Sheets(nuprest).Delete

Next nuprest

Application.DisplayAlerts = True

End Sub

merci de m'aider !

cordialement honnoe

Bonjour et bienvenue sur le forum

Essaie ce code :

Option Explicit

Const FA = "Accueil"
Const CelPrest = "B2"
Const FM = "Modele"
Const celnuPrest = "A1"
Const FP = "Prestation n° "
Dim f, nbF, nbFMax

Public Sub OK()
    Dim nbprest As Long, nuprest As Long
    nbFMax = 0
    For Each f In Worksheets
        If Left(f.Name, 13) = "Prestation n°" Then
            nbF = Val(Split(f.Name, " ")(2))
            If nbF > nbFMax Then nbFMax = nbF
        End If
    Next f

    nbprest = Sheets(FA).Range(CelPrest).Value
    If nbprest = 0 Then Exit Sub
    For nuprest = 1 To nbprest
        nbF = Sheets.Count
        Sheets(FM).Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = FP & nbFMax + 1 'nuprest
        ActiveSheet.Range(celnuPrest).Value = FP & nbFMax + 1
        nbFMax = nbFMax + 1
    Next nuprest
    Sheets(FA).Select
End Sub

Public Sub RAZ()
Dim nbprest As Long, nuprest As Long
nbprest = Sheets.Count
If nbprest <= 2 Then Exit Sub
If MsgBox("Supprimer les feuilles Prestation", vbYesNo) = vbNo Then Exit Sub
Application.DisplayAlerts = False
For nuprest = nbprest To 1 Step -1
 If InStr(1, Sheets(nuprest).Name, FP) > 0 Then Sheets(nuprest).Delete
Next nuprest
Application.DisplayAlerts = True
End Sub

Bye !

Bonjour,

Je viens d'essayer la macros et cela ne fonctionne pas. Merci quand même

Pouvez vous essayer de comprendre voila le dossier.

Cordialement !

Honooe

Bonjour

C'est curieux, je viens de tester sur le fichier que tu as joint et cela a l'aire de fonctionner :

Au départ :

capture 1

Après clics sut Alt et k

capture 2

Détail de la feuille Prestation n° 1

capture 3

Détail de la feuille Prestation n° 2

capture 4

Bye !

oui ma macro fonctionne mais je ne veut pas que sa écrit sur chaque page "nombre de prestation 1" tu vois ce qui est écrit en haut à gauche sur chaque duplication.

Et le problème c'est que je n'arrive pas à le retirer :/ j'ai essayer de retirer chaque phrase du programme, etc et je ne comprend pas le problème surtout qu'aucune formule n'apparaît sur le modèle.

merci beaucoup!

Cordialement Honooe

Nouvelle version.

Bye !

je vous remercie , maintenant sa fonctionne!!!!!

Bien cordialement Honooe

Rechercher des sujets similaires à "macro duplicante"