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

sebbbbb

XLDnaute Impliqué
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

XLDnaute Impliqué
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

XLDnaute Impliqué
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
 

youky(BJ)

XLDnaute Barbatruc
Bonjour,
Me re voila
A essayer ceci
Bruno
VB:
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

XLDnaute Impliqué
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)

XLDnaute Barbatruc
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
VB:
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

XLDnaute Impliqué
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

upload_2018-12-9_14-9-41.png
 

Statistiques des forums

Discussions
311 733
Messages
2 082 011
Membres
101 866
dernier inscrit
XFPRO