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

 

[youky(BJ)]

Voici le fichier test
Chez moi ca fonctionne(la macro demande de mettre à jour je fait Annuler) et c'est bon
Bruno

 

[sebbbbb]

Bonjour Bruno
c'est étrange car lorsque je reprends le fichier j'ai toujours le bug
je joins le fichier initial à 3 onglets que tu m'avais aidé à développer ; je souhaiterai exactement la même chose mais avec 4 onglets (pJ également à 4 onglets)
merci à toi Bruno
Seb

 

[youky(BJ)]

Bon,
j'ai bien les 4 onglets qui se font, je viens de corriger ce qui est en rouge
Bruno
With WsMR
.Name = "Mobile MR" & 1 + IV
.UsedRange.Replace What:="Mobile MR" & IV, Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

 

[sebbbbb]

Merci Bruno pour ton aide

Effectivement celà fonctionne. Ce qui me gêne c'est ce message qui apparait lorsque l'on clique sur le bouton NEW (voir copie écran ci-dessous) et qui demande a sélectionner un onglet, alors que cela n'apparaissait pas dans l'ancienne version a 3 onglets.

crois tu que cela peut être modifié stp ?

mille merci pour le tps consacré

seb


Croi

 

[youky(BJ)]

Hello,
je n'ai pas ce message car les liens ne sont pas mis à jour à l'ouverture.
Ceci est dut aux liens.(moi je peux pas les mettre à jour)
Essayes de mettre en début de macro
Application.displayAlerte=false
et à True en fin de macro
Bruno

 

[sebbbbb]

ok je vais essayer
c'est étrange quand même non, car sur le fichier a 3 onglets je n'ai pas ce message ?

 

[sebbbbb]

cela ne fonctionne pas plus
sniff

 

[youky(BJ)]

Essayes d'enlever tous les liens dans le 4ème onglet juste pour tester.
Si ca fonctionne faudra voir autrement pour ces liens.
Attention demain je pars en bord de mer 15 jours et peu d'ordi (cause trop de soleil . . . . Cap d'Agde)
Bruno

 

[sebbbbb]

merci Bruno
j'ai trouve
en fait ton code initial fonctionnait très bien. c'est mon fichier test qui avait un problème

voici donc le code qui fonctionne chez moi

merci bcp ; sans ton aide j'étais bloqué

BONNES VACANCES

***
Option Explicit
Dim I, II, III, IV
Dim Ws As Worksheet
Dim WsBL As Worksheet
Dim WsPLBL As Worksheet
Dim WsCM As Object
Dim WsMR As Worksheet
Sub NEWblmobile()
I = 0: II = 0: III = 0: IV = 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
Case .Name Like "Mobile MR*"
IV = IV + 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
.UsedRange.Replace What:="Mobile BL" & II, Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
Sheets("Mobile CM1").Unprotect
.Sheets("Mobile CM1").Copy after:=.Sheets(.Sheets.Count)
Set WsCM = ActiveSheet
With WsCM
.Name = "Mobile CM" & 1 + III
.UsedRange.Replace What:="Mobile BL" & II, Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
Sheets("Mobile MR1").Unprotect
.Sheets("Mobile MR1").Copy after:=.Sheets(.Sheets.Count)
Set WsMR = ActiveSheet
With WsMR
.Name = "Mobile MR" & 1 + IV
.UsedRange.Replace What:="Mobile BL" & IV, Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With

End With
Application.ScreenUpdating = True
ActiveWorkbook.Protect ("")
End Sub


***

 

[sebbbbb]

Encore Merci Bruno
c'est top et c'est grâce à toi
many thanks

 

[sebbbbb]

Bonsoir Bruno

je reviens à nouveau vers toi sur ce thème

tu m'as bcp aidé avec plusieurs scripts. Apres de nombreux tests il s'avère que l'un fonctionne mieux que les autres ; celui-ci donc :

**
Sub Newblmobile()
Dim n, k, tx, onglet, deb, init, nb
init = "FM" ' les 2 premières lettres du dernier onglet
nb = 6 'nombre d'onglet à copier
ActiveWorkbook.Unprotect "motdepasse"
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 + 1 To deb
Sheets(k).Copy after:=Sheets(Sheets.Count)
tx = Replace(Sheets(k).Name, n, n + 1)
ActiveSheet.Name = tx
If Left(tx, 2) <> "BL" Then
ActiveSheet.Unprotect
For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
c.Formula = Replace(c.Formula, "BL impr." & n, "BL impr." & n + 1)
c.Formula = Replace(c.Formula, "Man" & n, "Man" & n + 1)
Next
End If
Next
ActiveWorkbook.Protect "motdepasse"
End Sub
**

ce script est adapté pour un jeu de 6 onglets appelés (dans l'ordre ci-dessous) :
- BL1 impr.1
- Pack. List1
- Man1
- MR1
- Letter1
- FM1

maintenant j'aimerai adapter ce code à un jeu de 4 onglets appelés (dans l'ordre ci-dessous) :
- SWB1
- PCK1
- CMA1
- REC1

j'ai fait plusieurs testS mais sans réussite. peux tu m'aider encore une fois stp ?

merci bcp par avance
Seb

 

[sebbbbb]

Bonjour
Un ptit coup de main svp ?
Je galere, pourtant il ne doit pas y avoir bcp a modifier
Merci
Seb

 

[youky(BJ)]

galere

Je n'ai que mon tel sous la main demain je regarde sur pc

Bonjour
Un ptit coup de main svp ?
Je galere, pourtant il ne doit pas y avoir bcp a modifier
Merci
Seb

 

[youky(BJ)]

Voici un peu tard mais bon c'est dimanche . . . .
J'ai repris mon dernier fichier et voici
Difficile de tester d'avantage
Bruno

 

[sebbbbb]

Merci Youky
désolé mais il y a un bug lorsqu'on lance la macro