Copier coller valeurs et mise en forme dans un autre classeur et sauvegarde

Bonjour,

Je souhaite Sauvegarder la feuille "Import" de mon classeur (Contenant plusieurs autres feuilles) dans un nouveau classeur à part.

J'arrive à le faire avec ce code que j'ai bricolé et qui fonctionne :

Sub SauvegarderFeuille()
    Worksheets("Import").Activate
         ActiveSheet.Copy
        Application.Dialogs(xlDialogSaveAs).Show
        ActiveWorkbook.Close
End Sub

Sauf que les formules de la feuille "Import" sont sauvegarder aussi. Avez vous une astuce pour ne sauvegarder que les valeurs et la mise en forme de l'onglet Import dans un autre classeur crée et avec la possibilité de choisir l'emplacement de sauvegarde et le nom du nouveau fichier.

Merci d'avance

J'ai essayé ce code

Sub CopieFeuilles()
  Set wb1 = ThisWorkbook
  Worksheets("Import").Activate
  ActiveSheet.Copy
  Set wb2 = Workbooks.Add
  With wb2.Worksheets("Feuil1").Select
  Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
  End With
  Application.Dialogs(xlDialogSaveAs).Show
  ActiveWorkbook.Close
End Sub

mais il y a un message d'erreur sur cette portion de code :

Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Et au lieu de créer un seul nouveau classeur, la macro en crée un second.

Une coup de main svp

Bonjour,

Une proposition.

Cdlt.

Public Sub CreateBook()
Dim ws As Worksheet, rng As Range, nSheet As Long
    nSheet = Application.SheetsInNewWorkbook
    With Application
        .ScreenUpdating = False
        .SheetsInNewWorkbook = 1
    End With
    Worksheets("Import").Copy
    With ActiveWorkbook
        On Error Resume Next
        Set rng = .Worksheets(1).UsedRange.SpecialCells(xlCellTypeFormulas)
        On Error GoTo 0
        If Not rng Is Nothing Then
            rng.Value = rng.Value
        End If
        Application.Dialogs(xlDialogSaveAs).Show
        .Close
    End With
    Application.SheetsInNewWorkbook = nSheet
End Sub

Bonjour Jean-Eric,

Merci beaucoup pour ton aide. Ton code fonctionne très bien.