sebbbbb
XLDnaute Impliqué
Bonjour
Gràce à l'aide de plusieurs d'entre vous j'ai constitué un petit fichier test qui me permet en cliquant sur un bouton de dupliquer un jeu de 4 onglets autant de fois que je clique sur le bouton. Evidemment les formules doivent également faire ref aux nouveaux onglets
Ce code fonctionne très bien sauf sur le premier onglet
En effet si je prends l'onglet CMA2 (après duplication) les liens ont bien fonctionnés car si je prends pour exemple la cell D15 elle fait bien ref à une autre de l'onglet SWB2. Idem si je prends la cell D26 du l'onglet REI2, elle fait ref à une cellule de l'onglet SWB2.
Le seul hic, correspond aux liens de l'onglet SWB2 (et autres onglets dupliqués commençant par SWB). En effet, dans cet onglet, si je prends pour exemple la cellule C30, celle ci fait ref à la cellule B42 l'onglet PCK1, alors que je voudrais que ce soit l'onglet PCK2
Voici ci dessous le code et en pj le fichier
**
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
**
merci à vous
seb
Gràce à l'aide de plusieurs d'entre vous j'ai constitué un petit fichier test qui me permet en cliquant sur un bouton de dupliquer un jeu de 4 onglets autant de fois que je clique sur le bouton. Evidemment les formules doivent également faire ref aux nouveaux onglets
Ce code fonctionne très bien sauf sur le premier onglet
En effet si je prends l'onglet CMA2 (après duplication) les liens ont bien fonctionnés car si je prends pour exemple la cell D15 elle fait bien ref à une autre de l'onglet SWB2. Idem si je prends la cell D26 du l'onglet REI2, elle fait ref à une cellule de l'onglet SWB2.
Le seul hic, correspond aux liens de l'onglet SWB2 (et autres onglets dupliqués commençant par SWB). En effet, dans cet onglet, si je prends pour exemple la cellule C30, celle ci fait ref à la cellule B42 l'onglet PCK1, alors que je voudrais que ce soit l'onglet PCK2
Voici ci dessous le code et en pj le fichier
**
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
**
merci à vous
seb
Dernière modification par un modérateur:
