WDAndCo
XLDnaute Impliqué
Bonsoir le Forum
Je voudrais copier des onglet avec le format et les valeurs. J'ai utilisé l'enregistreur, mais la copie ressemble plus a une copie d'écran sur un onglet ! Voici le code :
Quelqu'un a une solution, d'avance merci.
Je voudrais copier des onglet avec le format et les valeurs. J'ai utilisé l'enregistreur, mais la copie ressemble plus a une copie d'écran sur un onglet ! Voici le code :
Code:
Sub Sauvegarde()
Dim Nom$
Sheets("DJS").Select
Nom$ = Cells(2, 14) ' Nom du futur classeur
Sheets("Copie TNA").Visible = True
Sheets("Copie TNA").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Copie VHR").Visible = True
Sheets("Copie VHR").Select
Cells.Select
Selection.Delete Shift:=xlUp
Sheets("Volet TNA").Select
'ActiveWindow.SmallScroll Down:=-45
Range("K42").Select
ActiveSheet.Unprotect
Cells.Select
Selection.Copy
Sheets("Copie TNA").Select
Cells.Select
ActiveSheet.Buttons.Add(257.25, 459, 43.5, 19.5).Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
Sheets("Volet VHR").Select
ActiveSheet.Unprotect
Cells.Select
Selection.Copy
Sheets("Copie VHR").Select
Cells.Select
ActiveSheet.Buttons.Add(683.25, 254.25, 126.75, 4.5).Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("P:BC").Select
Selection.EntireColumn.Hidden = False
Sheets(Array("Copie TNA", "Copie VHR")).Select
Sheets("Copie VHR").Activate
Sheets(Array("Copie TNA", "Copie VHR")).Copy
ChDir "G:\CRU Equipe\Archive CRU"
ActiveWorkbook.SaveAs Filename:="G:\CRU Equipe\Archive CRU\" & Nom$ & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWindow.Close
ActiveWindow.SelectedSheets.Visible = False
Sheets("DJS").Select
End Sub
Quelqu'un a une solution, d'avance merci.