XL 2010 Dupliquer a loisir des onglets par bouton macro

sebbbbb

XLDnaute Impliqué
Bonjour

je viens faire appel à vos connaissances sur un sujet dont je bute depuis plusieurs semaines. j'ai eu de l'aide par certains d'entre vous mais j'ai toujours un ptit qq chose qui cloche aussi j'aimerai repartir de zéro.

voici donc ce que je cherche :

- j'ai sélectionné d'un gros fichier existant qui me sert de fichier test 4 onglets
- je souhaiterai que lorsque je clique sur le bouton "NEW" situé sur l'onglet SWB1, 4 nouveaux onglets s'affichent à la suite avec le même nom mais en ayant juste le nbre qui diffère. Ainsi à la suite des onglets SWB1, PCK1, CMA1, REI1 s'affichent les nouveaux onglets SWB2, PCK2, CMA2, REI2 et ainsi de suite autant de fois que l'on clique sur le bouton (SWB3, PCK3, CMA3, REI3 etc etc)

Certains d'entre vous m'on aidé dans cette tâche et cela fonctionne plutôt bien.

Seul hic, dont je me suis rendu compte ultérieurement c'est que les nouveaux onglets gardent les liens aux onglets originaux.

Je m'explique :
- si je prends pour exemple l'onglet CMA1, il y a des liens entres les cellules de cet onglet et celui SWB1 ; idem entre l'onglet PCK1 et SWB1 ou entre REI1 et SWB1
- 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

C'est la tout mon problème car actuellement 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

J'espère m'être exprimé clairement et que vous pourrez m'apporter votre aide

un énorme merci à vous qui vous pencherez dessus. j'avoue que cela m'enlèverait une grosse épine du pied

Seb
 
Dernière modification par un modérateur:

eriiic

XLDnaute Barbatruc
Bonjour à tous,

Je te propose de tester une autre technique.
Si on copie toutes les feuilles d'un coup, les formules sont mises à jour correctement.
Plus besoin de les retoucher, il n'y a que le renommage à s'occuper.
Tu indiques dans un array la liste des feuilles liées entre elles à dupliquer, que tu passes en paramètre à copieF() :
VB:
Sub test()
    copieF Sheets(Array("CMA1", "SWB1"))
End Sub

Sub copieF(arrF)
    Dim sh1 As Worksheet, sh2 As Worksheet, nb As Long, l As Long, nom As String
    arrF.Copy after:=Sheets(Sheets.Count)
    For Each sh1 In arrF
        nb = 0
        l = Len(sh1.Name)
        Do While Mid(sh1.Name, l, 1) >= "0" And Mid(sh1.Name, l, 1) <= "9"
            l = l - 1
        Loop
        nom = Left(sh1.Name, l)
        For Each sh2 In Worksheets
                If Left(sh2.Name, Len(nom)) = nom Then 'And Not Mid(sh2.Name, l + 1) Like " (#)" Then
                    nb = Application.Max(nb, Val(Mid(sh2.Name, l + 1)))
                End If
        Next sh2
        Sheets(sh1.Name & " (2)").Name = nom & Application.Max(1, nb) + 1
    Next sh1
End Sub
C'est le n° maxi qui est pris en compte.
Si tu as CMA4 présent et CMA3 de supprimé, la copie suivante sera CMA5.
Si les feuilles modèle n'ont pas de n°, les copies commencent quand même à 2.

Si tu as des noms sur les feuilles, il faudra les traiter avec la boite de dialogue qui apparait (renommer je pense).
Tu peux appeler la macro de n'importe où mais les feuilles modèle indiquées dans l'array doivent toujours exister. Sinon modifier la liste.
eric

PS : on peut imaginer un autre système où tu fais une sélection 3D des feuilles à dupliquer. Comme ça tu peux les choisir et plus besoin d'une liste des modèles.

PS2 : le code pour une sélection 3D :
VB:
Sub test()
    Dim nb As Long, listeF() As String, i As Long
    nb = InputBox("Nombre de feuilles à dupliquer ? ")
    ReDim liste(1 To nb)
    For i = 1 To nb
        liste(i) = Sheets(ActiveSheet.Index + i - 1).Name
    Next i
    copieF Sheets(liste)
End Sub
Le bouton doit se trouver sur la 1ère feuille du groupe et appeler la macro test()
Les feuilles doivent être consécutives.
Tu peux aussi remplacer l'inputbox par une valeur en dur, et avoir autant de macro d'appel que de choix de nombre de feuille (3, 4, etc)
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à @sebbbbb :), à tous ;),

Mon interprétation (pourquoi pas? :rolleyes:)
Le code:
VB:
Sub copier()
Dim pref(1 To 4), k&, num&, i&, xrg, j&
   pref(1) = "SWB": pref(2) = "PCK": pref(3) = "CMA": pref(4) = "REI"
   For k = Sheets.Count To 4 Step -1
      If Sheets(k).Name Like pref(4) & "*" Then num = 1 * Replace(Sheets(k).Name, pref(4), ""): Exit For
   Next k
   If k = 3 Then Exit Sub
   ActiveWorkbook.Unprotect "": Application.ScreenUpdating = False
   Application.DisplayAlerts = False: Sheets(Array(k - 3, k - 2, k - 1, k)).Copy after:=Sheets(Sheets.Count)
   Application.DisplayAlerts = True
   For i = 1 To 4: Sheets(Sheets.Count - 4 + i).Name = pref(i) & num + 1: Next
   For i = 1 To 4
      With Sheets(Sheets.Count - 4 + i).UsedRange
         .Parent.Activate
         For j = 1 To 4
            .Replace What:="'" & pref(j) & num & "'!", Replacement:="'" & pref(j) & num + 1 & "'!", _
            Lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
         Next j
      End With
   Next i
   ActiveWorkbook.Protect ""
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
est ce encore un prob avec des onglets cachés ?

Cela se peut car on se base sur les index des feuilles. Si une feuille masquée est présente parmi les n-3 feuilles à partir de la première feuille type REI trouvée en partant des feuilles les plus à droites, alors on ne recopiera pas les bonnes feuilles. On peut le corriger mais pour ne pas faire du code pour rien, il faudrait le fichier qui bogue et savoir comment cela se traduit.
 

Discussions similaires

Membres actuellement en ligne

Aucun membre en ligne actuellement.

Statistiques des forums

Discussions
312 086
Messages
2 085 197
Membres
102 814
dernier inscrit
JLGalley