Enregistrer sous une feuille dans un autre classeur avec VBA

Bonjour à toutes & tous,

Je souhaiterai faire un "enregistrer sous" d'une "zone de feuille excel" (A1 : E62) d'un classeur avec vba et qui, si c'est possible, avoir pour nom de classeur une référence de cellule de la feuille à copier (B8) et peut importe le nom de la feuille copiée , l'important est le nom du nouveau classeur qui doit avoir pour nom la cellule.

Je suppose que ce sujet a déjà été abordé mais je n'ai pas réussi à trouver...

J'ai déjà ces lignes de codes, cela fonctionne mais cela me duplique la feuille entière au lieu d'une zone...

Merci !

Private Sub _Click()

Dim fichier As String
On Error Resume Next
 ActiveSheet.Range("A1:E62").Select

ChDir "C:\users\xxxxxxx\desktop"
fichier = Application.GetSaveAsFilename( _
    fileFilter:="Excel Files (*.xls), *.xls")

    nomfic = Range("B8").Value & ".xls"

ActiveWorkbook.SaveAs Filename:=nomfic

If fichier <> False Then ThisWorkbook.SaveAs fichier
End Sub

Bonjour toutes et tous

EDIT arf, oui le nom de la valeur de la cellule

crdlt,

André

En changeant mes lignes, je suis arrivé à un résultat presque satisfaisant, il ne me manque plus à trouver comment enregistrer uniquement que la zone sélectionnée (A1:E62) et si vous avez le code pour conserver les caractères spéciaux. Merci

Private Sub Ciblex_TXT_Click()
Dim Nom As String
Nom = Range("B8") & ".xls"
If ThisWorkbook.Path = "" Then 'si le document n'a jamais été enregistré
  SendKeys Nom
  Application.Dialogs(xlDialogSaveAs).Show 'boîte de dialogue Enregistrer sous
Else
  If Range("B8") = "" Then MsgBox "Entrez le nom du fichier en b8", 48: Range("B8").Select: Exit Sub
  If MsgBox("Voulez-vous enregistrer le fichier sous le nom " & Nom & " ?", 4) = 6 Then
    On Error Resume Next
    ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Nom 'Enregistre dans le même dossier
    If Err Then MsgBox "Le nom proposé contient des caractères interdits", 48: Range("B8").Select
  End If
End If
End Sub

pour les caractères spéciaux, il suffisait juste de supprimer SendKeys Nom.

Bon, cela fonctionne mais il faudrait aussi que cela enregistre mon classeur du départ...

Re,

j'ai un peu cherché mais, tu as fais le plus balèze du travail ^^

j'ai trouvé ceci qui m'a l'air convaincant pour la plage à copier reste plus qu'à combiner le tout et supprimer date etc ( à mettre sur la feuill1 par exemple)

Sub ColleEtSauveII()
' source : https://www.developpez.net/forums/d748305/logiciels/microsoft-office/excel/macros-vba-excel/enregistrer-plage-cellules-fichier/

Dim D_WKB As Workbook, Chemin As String, NFic As String
Dim S_WKB As Workbook: Set S_WKB = ThisWorkbook
Dim MaPlage As Range
Set MaPlage = S_WKB.Worksheets(1).Range("A1:E62")

Chemin = "C:\Users\MONIDMONIDMONID\Desktop\"
NFic = "classeur_" & Format(Date, "yyyy-mm-dd") & ".xls"
Application.ScreenUpdating = False
MaPlage.Copy
Set D_WKB = Workbooks.Add(xlWBATWorksheet)
With D_WKB.ActiveSheet
    .Paste
        With .UsedRange
            .Value = .Value
        End With
End With
Application.CutCopyMode = False
D_WKB.SaveAs Chemin & NFic
D_WKB.Close True
Application.ScreenUpdating = True
End Sub

@méditer

crdlt,

André

Bonjour André,

Merci et je vais méditer cela ce matin.

Nickel !

Merci