XL 2010 Prob avec sélection d'un onglet

Bonjour

j'ai mis bcp de temps de faire le script ci-dessous qui fonctionne très bien.

---

Option Explicit
Dim I, II, III, IV, V
Dim Ws As Worksheet
Dim WsBL As Worksheet
Dim WsPLBL As Worksheet
Dim WsCM As Worksheet
Dim WsRe As Worksheet
Dim WsSWBS As Object
Sub NEWblmobile()
I = 0: II = 0: III = 0: IV = 0: V = 0
Application.ScreenUpdating = False
With ActiveWorkbook
.Unprotect ("BOURDAN1309")
For Each Ws In .Worksheets
With Ws
Select Case True
Case .Name Like "BL Mobile*"
I = I + 1
Case .Name Like "PL Mobile*"
II = II + 1
Case .Name Like "Man Mobile*"
III = III + 1
Case .Name Like "Receipt*"
IV = IV + 1
Case .Name Like "SWB service*"
V = V + 1
End Select
End With
Next Ws
.Sheets("BL Mobile1").Copy after:=.Sheets(.Sheets.Count)
Set WsBL = ActiveSheet
With WsBL
.Name = "BL Mobile" & 1 + I
End With
.Sheets("PL Mobile1").Copy after:=.Sheets(.Sheets.Count)
Set WsPLBL = ActiveSheet
With WsPLBL
.Name = "PL Mobile" & 1 + II
.UsedRange.Replace What:="BL Mobile1", Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
.Sheets("Man Mobile1").Copy after:=.Sheets(.Sheets.Count)
Set WsCM = ActiveSheet
With WsCM
.Name = "Man Mobile" & 1 + III
.Unprotect
.UsedRange.Replace What:="BL Mobile1", Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Protect
End With
.Sheets("Receipt1").Copy after:=.Sheets(.Sheets.Count)
Set WsRe = ActiveSheet
With WsRe
.Name = "Receipt" & 1 + IV
.UsedRange.Replace What:="BL Mobile1", Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
.Sheets("SWB service1").Copy after:=.Sheets(.Sheets.Count)
Set WsSWBS = ActiveSheet
With WsSWBS
.Name = "SWB service" & 1 + V
.UsedRange.Replace What:="BL Mobile1", Replacement:=WsBL.Name, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End With
End With
Application.ScreenUpdating = True

ActiveWorkbook.Protect "BOURDAN1309"
Set WsBL = ActiveSheet
MsgBox "NE PAS OUBLIER D'INDIQUER LE NUMERO DU NOUVEAU BL"

End Sub

--

Le but étant que lorsque je clique sur un bouton, 6 onglets sont dédoublés avec le num qui se modifie dans le nom de l'onglet

ainsi si je clique sur le bouton situé dans l'onglet BL Mobile1, un onglet se créé automatiquement qui prend le nom BL Mobile2 et ainsi de suite. 5 onglets s'ajoutent en même tps pour que chacun se termine par 2 puis ensuite 3 et ainsi de suite.
les 5 onglets d'origine s'appellent :
- BL Mobile1
- PL Mobile1
- Man Mobile1
- Receipt1
- SWB service1

mon problème est que je voudrais qu'à chaque fois que je clique sur le bouton, et une fois que le jeu d'onglet a été ajouté, la page sélectionnée (donc visible à l'écran corresponde au dernier onglet BL Mobile? - le point d'interrogation correspondant au dernier numéro

actuellement le dernier onglet affiché correspond à SWB service? - le point d'interrogation correspondant au dernier numéro

j'espère être assez clair dans mes explications

merci par avance
seb