Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
 
Trier par date Trier par votes

sebbbbb

XLDnaute Impliqué
Tu m'avais créé ce scrip qui marche bien pour un autre jeu de 6 onglets; peux tu l'adapter pour mes 4 onglets stp :
- SWB1
- PCK1
- CMA1
- REC1

**

Sub NEWblmobile()
Dim n, k, tx, onglet, deb, init, nb
init = "FM" ' les 2 premi?re lettre du dernier onglet
nb = 6 'nombre d'onglet ? copier
ActiveWorkbook.Unprotect ""
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 ""
End Sub

**

merci
seb
 
Vote positif 0 Vote négatif

youky(BJ)

XLDnaute Barbatruc
Bonsoir,
Essaye comme ceci
Bruno
VB: 
Sub NEWblmobile()
Dim n, k, tx, onglet, deb, init, nb
init = "RE" ' les 2 premiere lettre du dernier onglet
nb = 4 'nombre d'onglet ? copier
ActiveWorkbook.Unprotect ""
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
'                                                             ici c'est pour modifier les formules
       '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 ""
End Sub
 
Vote positif 0 Vote négatif

youky(BJ)

XLDnaute Barbatruc
Voici,
Je ne m'occupe plus des formules (je sais pas)
Bruno

Tu m'avais donné comme dernier onglet REC1 et c'est REI1
VB: 
Sub NEWblmobile()
Dim n, k, tx, onglet, deb, init, nb
'retifié cette ligne
init = "REI" ' les lettre du dernier onglet sans le chiffre
nb = 4 'nombre d'onglet ? copier
ActiveWorkbook.Unprotect ""
For k = Sheets.Count To 1 Step -1
If Left(Sheets(k).Name, 3) = init Then 'mis 3 au lieu de 2
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
'                                                             ici c'est pour modifier les formules
       '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 ""
End Sub
 
Vote positif 0 Vote négatif

sebbbbb

XLDnaute Impliqué
bonjour Youky

en fait le problème vient que dans le code en marron, cela fait ref a des onglets qui ne sont pas dans mon fichier test notamment les onglets BL, BL impr. ou l'onglet Man

c'est pour celà que je t'ai envoyé mon fichier 'testfichier' qui lui a pour onglet a prendre comme ref

- SWB1
- PCK1
- CMA1
- REI1

je te remercie sincèrement par avance

Seb
 
Vote positif 0 Vote négatif

sebbbbb

XLDnaute Impliqué
re bonjour Youky

merci enormément pour ton aide

j'ai retravaillé le scrip selon tes indications et cela fonctionne bien pour la duplication

helas il reste un hic (ce serait trop simple ) j'aimerai que les liens restent identiques mais par contre entre les nouveaux onglets c'est à dire entre CMA2 et SWB2, PCK2 et SWB2 ou REI2 et SWB2

avec ton script les les liens restent entre CMA2 et SWB1, PCK2 et SWB1 ou REI2 et SWB1 et ainsi de suite avec les autres onglets ; ce qui fausse complètement mes données

peux tu y remédier stp ?
merci a toi

seb
 
Vote positif 0 Vote négatif

sebbbbb

XLDnaute Impliqué
Bonsoir Youki

revoila le casse pieds de service

merci encore pour ton boulot qui me ravit
j'aurai juste une dernière requete si cela est faisable de ton coté

Tous les liens entre les feuilles fonctionnent parfaitement bien sauf sur le 1er onglet "SWB1" et donc ses duplicats

je m'explique

si tu prends la cellule AX33 dans l'onglet SWB1, elle est liée à la cellule B42 de l'onglet PCK1 ; apres duplication la cellule AX33 de l'onglet SWB2 devrait être liée à la cellule B42 de l'onglet PCK2, ce qui n'est pas le cas (elle reste liée à la cellule B42 de l'onglet PCK1)

Puis je a nouveau abuser de ta gentillesse et de tes connaissances ?

merci à toi Youki
seb
 
Vote positif 0 Vote négatif

youky(BJ)

XLDnaute Barbatruc
Hello,
En AX33 de l'onglet SWB1 j'ai 4,00Kg
Je pense que les formules ont disparues
En B42 de PCK1 j'ai je pense affaire à une funtion.
ici que j'ai laissé en vert dans la macro
'c.Formula = Replace(c.Formula, "Man" & n, "Man" & n + 1)
dans cette exemple on remplace Man1 par Man2
Man est le nom de l'onglet sans le chiffre
Fait des essais en tout genre en enlevant l'apostrophe
Bruno
 
Vote positif 0 Vote négatif

sebbbbb

XLDnaute Impliqué
je vois ce que tu veux dire (enfin je crois ) mais ce qui est étonnant c'est que le hic correspond au 1er onglet "SWB1" et donc ses duplicats pourtant tu as déjà mis la formule magique :

c.Formula = Replace(c.Formula, "BL Mobile" & n, "BL Mobile" & n + 1)

qui si j'ai bien compris fait les modif pour que les liens entre cellules se fassent en fonction des noms des onglets donc dans l'exemple évoqué ci-dessus la cellule AX33 de l'onglet SWB2 devrait être liée à la cellule B42 de l'onglet PCK2, ce qui n'est pas le cas (elle reste liée à la cellule B42 de l'onglet PCK1)

merci à toi

quel casse-tête

Seb
 
Vote positif 0 Vote négatif

youky(BJ)

XLDnaute Barbatruc
C'était pourtant facile . . .
voici à tester
Bruno
VB: 
Sub NEWblmobile()
Dim n, k, tx, onglet, deb, init, nb
'retifié cette ligne
init = "REI" ' les lettre du dernier onglet sans le chiffre
nb = 4 'nombre d'onglet ? copier
ActiveWorkbook.Unprotect ""
For k = Sheets.Count To 1 Step -1
If Left(Sheets(k).Name, 3) = init Then 'mis 3 au lieu de 2
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, 3) <> "SWB" Then
    ActiveSheet.Unprotect
'                        ici c'est pour modifier les formules
       For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas)
           c.Formula = Replace(c.Formula, "SWB" & n, "SWB" & n + 1)
           c.Formula = Replace(c.Formula, "PCK" & n, "PCK" & n + 1)
       Next
 End If
Next
ActiveWorkbook.Protect ""
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

  • Résolu(e)
XL 2010 Prob avec sélection d'un onglet
2
Réponses
21
Affichages
2 K
sebbbbb
  • Question
XL 2010 Création et ajout d'onglets par bouton macro selon plusieurs critères
Réponses
3
Affichages
1 K
sebbbbb
B
  • Question
Copie d'un onglet existant avec ajout de date dans le nom de l'onglet
Réponses
3
Affichages
2 K
JNP
J
  • Question
Declancher un userform sur un bouton special et un prob avec le pleine ecran!
Réponses
3
Affichages
2 K
jimmy59940
J
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…