Enregistrer une feuille dans un nouveau classeur

Bonjour à tous,

Je souhaite créer une macro afin d'enregistrer un onglet dans un nouveau classeur.

Voici le contexte :

J'ai un classeur de travail dans lequel j'ai plusieurs onglets.

Je souhaite copier-coller en valeur l'onglet "test" dans un nouveau classeur.

Ce nouveau classeur n'existe pas encore. La macro doit donc ouvrir un nouvel Excel et créer un onglet portant le nom de "test". Je veux densuite retourner sur l'onglet "Test" de mon classeur de travail afin de la copier et de la coller en valeur dans mon nouveau classeur. Pour finir, je souhaite nommer ce nouveau classeur Work_nom_client et ensuite enregistrer ce nouveau classeur à un emplacement spécifique.

Merci d'avance pour aide !

Marie

Bonjour,

Une macro ou il y a juste à changer le nom et chemin :

Sub Macro1()
    Sheets("Test").Copy
    Cells.Copy
    [A1].PasteSpecial Paste:=xlPasteValues
    ActiveWorkbook.SaveAs Filename:="D:\Documents\_EXC\test.xlsx"
    ActiveWindow.Close
End Sub

A+

Bonjour,

galopin01 bonjour,

moi j'avais plus simple !

Sub Copie_ActiveSheet()
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Dim Nom_feuille As String ' définition d'une variable alphanumérique
    Nom_feuille = ActiveSheet.Name ' mise en mémoire de la feuille qui va être copiée
    ActiveSheet.Copy After:=Sheets(Worksheets.Count) ' on crée une copie de la feuille à la fin du classeur
    ActiveSheet.Name = Nom_feuille & "_LRD" ' on renome la feuille qui sera extraite 'attention ! 31 caractères max !)
    Cells.Select ' on y sélectionne toutes les cellules
    Selection.Copy ' on copie
    Selection.PasteSpecial Paste:=xlPasteValues ' et on colle "les valeurs"

    Set Sourcewb = ActiveWorkbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    With Destwb
        If Val(Application.Version) < 12 Then
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "You answered NO in the security dialog."
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = "LouReeD Test " & Format(Now, "dd-mmm-yy h-mm-ss")

    Destwb.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

    Application.DisplayAlerts = False ' arrêt des alertes d'Excel
        Sourcewb.Activate
        Sourcewb.Sheets(Sourcewb.Worksheets.Count).Delete  ' suppression de la feuille créée plus haut
        Sourcewb.Sheets(Nom_feuille).Activate ' on retourne sur la feuille source
        Range("A1").Select
    Application.DisplayAlerts = True ' remise en route des alertes d'Excel

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

@ bientôt

LouReeD