Private Sub enregistrer_classeur_bis()
Dim oWb As Workbook, nWb As Workbook
Dim oWs As Worksheet, so As Worksheet, sn As Worksheet
Dim VbP As Object, VbC As Object, v As Object, mo As Object
Dim i%, FNm$, SNm$, s$
Set oWb = ThisWorkbook
Set VbP = oWb.VBProject
Set VbC = VbP.VBComponents
SNm = "Entreprise"
Set oWs = oWb.Worksheets(SNm)
FNm = oWs.Cells(6, 8)
Workbooks.Add
Set nWb = ActiveWorkbook
If oWb.Worksheets.Count > nWb.Worksheets.Count Then
For i = nWb.Worksheets.Count + 1 To oWb.Worksheets.Count
nWb.Sheets.Add
Next i
End If
For i = 1 To oWb.Worksheets.Count
Set so = oWb.Worksheets(i)
Set sn = nWb.Worksheets(i)
so.Cells.Copy Destination:=sn.Cells(1, 1)
sn.Name = so.Name
sn.Visible = so.Visible
Set mo = oWb.VBProject.VBComponents.Item(so.CodeName)
s = mo.Codemodule.Lines(1, mo.Codemodule.CountOfLines)
nWb.VBProject.VBComponents.Item(sn.CodeName).Codemodule.AddFromString (s)
Next i
Set mo = oWb.VBProject.VBComponents.Item("Thisworkbook")
s = mo.Codemodule.Lines(1, mo.Codemodule.CountOfLines)
nWb.VBProject.VBComponents.Item("Thisworkbook").Codemodule.AddFromString (s)
Application.DisplayAlerts = False
nWb.SaveAs Filename:=oWb.Path & "\Etudes\" & FNm & ".xlsm", FileFormat:=52
Application.DisplayAlerts = True
nWb.Close
End Sub