deplacer une feuille dans un nouveau classeur sans liaisons

[satwaf]

Bonjour a tous,

voila mon problême, actuellement j'ai un classeur avec une feuille qui me sert de modèle pour editer un essai, et qui est en liaison avec deux feuilles du meme classeur,
donc pour editer un essai a part entiere, je duplique cette feuille ,je copie les valeurs et je fais un collage special des valeurs, de maniere a ne plus avoir de formules en liaisons avec les deux feuilles, et partir de la je la deplace dans un nouveau classeur.
le seul probleme c'est qu'une liaison se crée, et je ne sais pas comment eviter cette liaison, comment pourrais je l'eviter avec un code VB

voila le code!!!

Pouvez vous m'aider s'il vous plait


Sub creation_nouvel_essai()
' creation_nouvel_essai Macro
'
Dim Dwo As Object
Application.ScreenUpdating = False
'duplicata de la feuille essai
Sheets("Essai").Copy Before:=Sheets(1)
Sheets("Essai (2)").Unprotect Password:="bpe2010"
'renommer la copie de la feuille essai
Sheets("Essai (2)").Name = "New_test"
Sheets("new_test").DrawingObjects.Delete
'copie et collage special des valeurs pour les cellules
'en liaison avec la feuille formulation
Sheets("new_test").Range("E7:H7").Copy
Sheets("new_test").Range("E7:H7").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("E9:N9").Copy
Sheets("new_test").Range("E9:N9").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C13:e23").Copy
Sheets("new_test").Range("C13:e23").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C24:d27").Copy
Sheets("new_test").Range("C24:d27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C28:e30").Copy
Sheets("new_test").Range("C28:e30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("e24:e27").Copy
Sheets("new_test").Range("e24:e27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("G13:G30").Copy
Sheets("new_test").Range("G13:G30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("J13:J30").Copy
Sheets("new_test").Range("J13:J30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K13:K21").Copy
Sheets("new_test").Range("K13:K21").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K22:K23").Copy
Sheets("new_test").Range("K22:K23").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K24:K30").Copy
Sheets("new_test").Range("K24:K30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("N13:N27").Copy
Sheets("new_test").Range("N13:N27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Protect Password:="bpe2010"
'deplacer New_test dans un nouveau classeur
Sheets("New_test").Move

End Sub

 

[sasjm37]

Re : deplacer une feuille dans un nouveau classeur sans liaisons

Bonjour satwaf,
j'ai rajouté le code à la fin de ta macro.

Sub creation_nouvel_essai_V2()
' creation_nouvel_essai Macro
'
Dim Dwo As Object
Application.ScreenUpdating = False
'duplicata de la feuille essai
Sheets("Essai").Copy Before:=Sheets(1)
Sheets("Essai (2)").Unprotect Password:="bpe2010"
'renommer la copie de la feuille essai
Sheets("Essai (2)").Name = "New_test"
Sheets("new_test").DrawingObjects.Delete
'copie et collage special des valeurs pour les cellules
'en liaison avec la feuille formulation
Sheets("new_test").Range("E7:H7").Copy
Sheets("new_test").Range("E7:H7").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("j2:J9").Copy
Sheets("new_test").Range("j2:J9").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C13:e23").Copy
Sheets("new_test").Range("C13:e23").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C24:d27").Copy
Sheets("new_test").Range("C24:d27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C28:e30").Copy
Sheets("new_test").Range("C28:e30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("e24:e27").Copy
Sheets("new_test").Range("e24:e27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("G13:G30").Copy
Sheets("new_test").Range("G13:G30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("J13:J30").Copy
Sheets("new_test").Range("J13:J30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K13:K21").Copy
Sheets("new_test").Range("K13:K21").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K22:K23").Copy
Sheets("new_test").Range("K22:K23").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K24:K30").Copy
Sheets("new_test").Range("K24:K30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("N13:N27").Copy
Sheets("new_test").Range("N13:N27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Unprotect Password:="bpe2010"
'deplacer New_test dans un nouveau classeur
Dim stab() As Variant ' création d'un tableau dynamique
stab = ActiveSheet.UsedRange.Value ' récupération des données de la feuille dans le tableau
Workbooks.Add ' création d'un nouveau classeur
Range(Cells(1, 1), Cells(UBound(stab, 1), UBound(stab, 2))) = stab ' remplissage de la feuille
End Sub

 

[satwaf]

Re : deplacer une feuille dans un nouveau classeur sans liaisons

je viens de tester ta solution sasjm37, le probleme est que lorsque je créee une nouvelle feuille d'essai, les liaisons avec les autres feuilles sont rompues, mais je conserve quelques formules de calculs dans la feuille. la meilleure solution serait peu etre de créer une copie dans un nouveau classeur et ensuite revenir sur mon classeur d'origine , et de supprimer new test.

 

[satwaf]

Re : deplacer une feuille dans un nouveau classeur sans liaisons

en fait l'idéal , serait qu'a partir du moment ou je dois deplacer la feuille new test, donc en fin de macro, je la copie dans un nouveau classeur et que je revienne sur le classeur de départ et que je supprime la feuille new test, seulement je ne sais pas comment garder le nom du fichier en memoire pour pouvoir y revenir une fois que le nouveau classeur est créé

 

[sasjm37]

Re : deplacer une feuille dans un nouveau classeur sans liaisons

Bonjour satwaf, le fil,
Voila une fin procédure qui devrait répondre à tes attentes, ça reste hyper basique...

Sub creation_nouvel_essai()
' creation_nouvel_essai Macro
'
Dim Dwo As Object
Application.ScreenUpdating = False
'duplicata de la feuille essai
Sheets("Essai").Copy Before:=Sheets(1)
Sheets("Essai (2)").Unprotect Password:="bpe2010"
'renommer la copie de la feuille essai
Sheets("Essai (2)").Name = "New_test"
Sheets("new_test").DrawingObjects.Delete
'copie et collage special des valeurs pour les cellules
'en liaison avec la feuille formulation
Sheets("new_test").Range("E7:H7").Copy
Sheets("new_test").Range("E7:H7").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("E9:N9").Copy
Sheets("new_test").Range("E9:N9").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C13:e23").Copy
Sheets("new_test").Range("C13:e23").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C24:d27").Copy
Sheets("new_test").Range("C24:d27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("C28:e30").Copy
Sheets("new_test").Range("C28:e30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("e24:e27").Copy
Sheets("new_test").Range("e24:e27").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("G13:G30").Copy
Sheets("new_test").Range("G13:G30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("J13:J30").Copy
Sheets("new_test").Range("J13:J30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K13:K21").Copy
Sheets("new_test").Range("K13:K21").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K22:K23").Copy
Sheets("new_test").Range("K22:K23").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("K24:K30").Copy
Sheets("new_test").Range("K24:K30").PasteSpecial Paste:=xlPasteValues
Sheets("new_test").Range("N13:N27").Copy
Sheets("new_test").Range("N13:N27").PasteSpecial Paste:=xlPasteValues

'deplacer New_test dans un nouveau classeur
fichier_1 = ActiveWorkbook.Name 'récupere le nom du premier fichier
Workbooks.Add 'crée un nouveau classeur nommer New_classeur
ActiveWorkbook.SaveAs Filename:="New_classeur"
fichier_2 = ActiveWorkbook.Name 'récupere le nom du deuxieme fichier
ActiveSheet.Name = "new_test" ' nomme la feuille de ce classeur
Windows(fichier_1).Activate ' retourne dans le premier fichier
Range("A1").CurrentRegion.Copy ' copy la feuille new_test
Windows(fichier_2).Activate ' active le deuxieme fichier
Range("A1").PasteSpecial ' colle les données
ActiveSheet.Protect Password:="bpe2010" ' protége
Windows(fichier_1).Activate ' active le premier fichier
ActiveSheet.Delete ' supprime la feuille new_test

' cordialement SASJM37

End Sub