XL 2010 intégrer plusieurs fois le même onglet (avec nom leg différent) a un classeur par macro bouton

[sebbbbb]

Bonsoir tout le monde

j'ai un problème à vous soumettre qui me semble insurmontable . Mais avec vous je sais que rien n'est impossible.

Voila j'ai une macro qui marche avec un bouton. Lorsque je clique sur le bouton, plusieurs onglets qui sont cachés apparaissent dans mon classeur. jusque là tout marche parfaitement

Est il possible que lorsque je clique a nouveau sur le même bouton les mêmes onglets s'ajoutent en plus des autres avec un nom d'onglets légèrement différent.

Voici mon code actuel :

Option Explicit
Sub blcmmobile()
'
' blcmmobile Macro
'
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect ("")
Sheets("BL1").Visible = True
Sheets("Packing List BL1").Visible = True
Sheets("CM1").Visible = True
Sheets("BL1 ").Select
Range("BM3:BN3").Select
ActiveWorkbook.Protect ("")
Application.ScreenUpdating = True
End Sub

Ainsi lorsque je clique sur mon bouton j'ai 3 onglets qui apparaissent avec le nom et l'ordre suivant :
- BL1
- Packing List BL1
- CM1

peut on modifier le script de façon à ce que lorsque je clique à nouveau sur le même bouton apparaissent à la suite des onglets ci-dessus 3 autres appelés :
- BL2
- Packing List BL2
- CM2

et ainsi de suite :
- BL3
- Packing List BL3
- CM3

Un grand merci par avance pour votre aide

seb

 

[sebbbbb]

bizarre
tous les onglets sont maintenant protégés
je ne vois pas ou tu inseres tes scrips

 

[sebbbbb]

Bravo ! c'est exactement comme çà que je le voulais. Un énorme merci a toi pour ton aide
Seb

 

[sebbbbb]

bonjour
je reviens vers vous concernant ce post
j'ai essayé de modifier ce post de façon a pouvoir doubler, tripler...un jeu de 6 onglets appelé :
- BL1
- Impr. BL1
- PL BL1
-CM1
- MR1
-FM1

Il faudrait je pense se baser cette formule (merci chti160) qui est parfaite pour un jeu de 3 onglets mais je bloque pour augmenter à 6 onglets. Pourriez vous me donner un petit coup de main svp ?

Option Explicit
Dim I, II, III
Dim Ws As Worksheet
Dim WsBL As Worksheet
Dim WsPLBL As Worksheet
Dim WsCM As Object
Sub NEWblmobile()
I = 0: II = 0: III = 0
Application.ScreenUpdating = False
With ActiveWorkbook
.Unprotect ("")
For Each Ws In .Worksheets
With Ws
Select Case True
Case .Name Like "Mobile BL*"
I = I + 1
Case .Name Like "Packing List BL*"
II = II + 1
Case .Name Like "Mobile CM*"
III = III + 1
End Select
End With
Next Ws
.Sheets("Mobile BL1").Copy after:=.Sheets(.Sheets.Count)
Set WsBL = ActiveSheet
With WsBL
.Name = "Mobile BL" & 1 + I
End With
.Sheets("Packing List BL1").Copy after:=.Sheets(.Sheets.Count)
Set WsPLBL = ActiveSheet
With WsPLBL
.Name = "Packing List BL" & 1 + II
.Unprotect
.UsedRange.Replace What:="Mobile BL1", Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Protect
End With
.Sheets("Mobile CM1").Copy after:=.Sheets(.Sheets.Count)
Set WsCM = ActiveSheet
With WsCM
.Name = "Mobile CM" & 1 + III
.Unprotect
.UsedRange.Replace What:="Mobile BL1", Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Protect
End With
End With
Application.ScreenUpdating = True
ActiveWorkbook.Protect ("")
End Sub



merci
seb

 

[sebbbbb]

bonjour jean Marie
En fait le fichier fonctionne tellement bien que je souhaite l'adapter a d'autres qui eux comporte 6 onglets. mais je te confirme que l'autre fichier m'a vraiment dépanné, et je l'ai adapté plusieurs fois.
le hic est maintenant de l'adaptera des versions avec un nbr d'onglets supérieur
j'ai bien essayé d'ajouter des select case
je vais encore essayé de mon coté
merci
seb

 

[sebbbbb]

voila le fichier sur lequel je travaille
mais toujours un bug que je n'arrive pas a resoudre
merci par avance
seb

 

[sebbbbb]

Bonjour
je me permets de vous relancer sur ce sujet car je bloque. cela ne devrait pas etre complique mais cela me depasse.
un grand merci par avance
seb

 

[sebbbbb]

bonsoir
merci pour ton retour
je pense que c'est une protection sans MDP mais je veroifie quand meme

 

[youky(BJ)]

Bonjour,
Me re voila
A essayer ceci
Bruno

Sub Ajouter()
Dim n, k, tx
ActiveWorkbook.Unprotect "AIRBUS"
n = Val(Replace(Sheets(Sheets.Count).Name, "FM", ""))
For k = Sheets.Count - 5 To Sheets.Count
tx = Replace(Sheets(k).Name, n, n + 1)
Sheets(k).Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = tx
Next
End Sub

 

[sebbbbb]

super !
C'est parfait
merci a vous 2
Youki ? si je veux ajouter d'autres onglets je suppose que je n'ai qu'a le "5" par le nombre d'onglets concernés et changer le nom du dernier onglet ?
seb

 

[sebbbbb]

Bonjour a nouveau
Youki : ton scrip me va parfaitement car il est court est je peux facilement l'adapté à d'autres situation.
le hic c'est que lorsque je l'intègre à mon projet, il y a bug je pense que c'est parce qu' il y a d'autres onglets qui peuvent se trouver devant ou derriere ceux a doubler. Tu me diras qu'il n'y a qu'a modifier le script en fonction du nbre d'onglets devant mais le hic c'est que selon les situations et d'autres macro, il peut y avaoir un nombre variable d'onglet devant ou derrier le jeu d'onglets a multiplier.
penses tu que ton script peut etre modifié ?
merci par avance pour ton / votre aide

 

[youky(BJ)]

Bonsoir,
Dans cette macro tu peux avoir des onglets devant ou derrière.
Indique seulement dans la macro les 2 lettres du dernier onglet et aussi le nombre d'onglets.
c'est init=?? et nb=?
Bruno

Sub Ajouter()
Dim n, k, tx, onglet, deb, init
init = "FM" ' les 2 premi?re lettre du dernier onglet
nb = 5 'nombre d'onglet ? copier
ActiveWorkbook.Unprotect "AIRBUS"
For k = Sheets.Count To 1 Step -1
If Left(Sheets(k).Name, 2) = init Then
deb = k
n = Val(Replace(Sheets(k).Name, init, ""))
tx = Replace(Sheets(k).Name, n, n + 1)
Exit For
End If
Next
For k = deb - nb To deb
Sheets(k).Copy after:=Sheets(Sheets.Count)
tx = Replace(Sheets(k).Name, n, n + 1)
ActiveSheet.Name = tx
Next
ActiveWorkbook.Protect "AIRBUS"
End Sub

 

[sebbbbb]

Bonjour Bruno
désolé pour retard a répondre
Helas ce ne fonctionne pas
je pense que c'est parce qu'il y a deja des fichiers devant et derriere ceux a copier

 

[sebbbbb]

ci-dessous l'écran avec mess erreur

 

[youky(BJ)]

Bonjour
Déclarer aussi "nb" dans les dim
Toutes les variables sont à déclarer lorsqu'il y a Option Explicit
Bruno

 

[sebbbbb]

bonjour Bruno
merci pour ta réponse rapide...qui me destabilise un peu
en fait j'ai recopié ton scrip dans ma macro mais je ne comprends pas bien ce que tu me proposes.
peux tu modifier ton scrip initial stp ?
merci
seb