Copier, coller, renommer et enregistrer dans un nouveau dossier

Bonjour à tous les membres.

je sollicite votre aide. J'ai un classeur nommé BD et contenant plusieurs feuilles que je veux copier sur un nouveau classeur nommé BD2 (que le code doit créer). Après avoir créé et copie les feuilles de BD sur BD2, je veux créer un dossier DSS sur le bureau de mon ordinateur et enregistrer le nouveau classeur BD2 dans le dossier.

j'ai essayé le code ci dessous.

- la création de la feuille est ok,

- la copie des feuilles sur nouveau classeur (classeur1) est ok.

- Création du Dossier DSS est ok

- Renommer le classeur1 en BD2 n'est pas ok

- Enregistrer le Classeur dans DSS n'est pas ok

Mon code vda se bloque en cours d'exécution, vers la fin du processus.

fichier joint.

merci d'avance

Sub CopierFeuilles et Enregistrer()
    Dim BD As Workbook
    Dim BD2 As Workbook
    Dim DSS As String 
    'Dim BD2 As String

    Set BD = Workbooks("BD")
    Set BD2 = Workbooks.Add

    For Each feuille In BD.Sheets
        feuille.Copy After:=BD2.Sheets(BD2.Sheets.Count)
    Next feuille

    DSS = Environ$("USERPROFILE") & "\Desktop\DSS\"   
    If Dir(DSS, vbDirectory) = "" Then
    MkDir DSS
    End If

    BD2 = DSS & "BD2.xls"

    BD2.SaveAs BD2
    BD2.Close SaveChanges:=False

End Sub

Bonsoir,

Pour copier un classeur, dans son intégralité, il suffit d'utiliser l'instruction :
ThisWorkbook.SaveCopyAs Chemin & "\" & Classeur_D

Chemin étant le nom du dossier destination, il doit être créé avant.

Classeur_D est le nom donné au nouveau classeur. Attention à l'extension, elle doit être égale à celle du classeur actif.

Bonne soirée

Ps : Il est préférable de placer ses fichiers (classeurs et autres) dans des dossiers spécifiques. A l'intérieur du dossier "Documents" par exemple (en créant des sous dossiers si besoin). Et, pour un accès rapide, on ajoute des raccourcis sur le bureau.

rép,

Bonjour Éric_angers.

Merci bien pour les conseils. Je vais reprendre et au besoin je vous reviens.

Cordialement

Bonjour,

Merci d'éviter les doublons --> https://forum.excel-pratique.com/excel/copier-coller-renommer-et-enregistrer-dans-un-nouveau-dossier...

Si vous n'avez pas de réponse il vous suffit de relancer votre demande sur le fil en créant un nouveau post

Crdlt

Merci bien DAN.

Problème résolu.
merci a tout le monde.

Sub CopierFeuillesEtEnregistrer()
    Dim BD As Workbook 
    Dim BD2 As Workbook 
    Dim DSS As String 
    Dim cheminBD2 As String 

    Set BD = Workbooks("BD")
    Set BD2 = Workbooks.Add

    For Each feuille In BD.Sheets
        feuille.Copy After:=BD2.Sheets(BD2.Sheets.Count)
    Next feuille

    DSS = Environ$("USERPROFILE") & "\Desktop\DSS\" 
    If Dir(DSS, vbDirectory) = "" Then
        MkDir DSS
    End If

    cheminBD2 = DSS & "BD2.xlms"
    BD2.SaveAs cheminBD2, FileFormat:=52
End Sub

Re

Je pense que le code que vous avez mis posera un souci. A vous de vérifier

Puisque terminé pensez à

Cordialement

Bonjour

2 petites erreurs dans votre code :

ligne 6 : ajouter .xlsm (BD.xlsm)

ligne 15 : l'extension = xlsm et non xlms

L'inconvénient dans votre code, c'est que l'instruction Add ajoute un classeur avec un nombre de feuilles prédéterminé dans les options d'Excel. Si l'option est fixée à 3 feuilles, et que le classeur BD en contient 5, le classeur BD2 contiendra 8 feuilles.

Si vous souhaitez faire une simple copie du classeur, le code suivant est largement suffisant.

Sub Copier_Classeur()

Dim DSS As String

DSS = Environ$("USERPROFILE") & "\Desktop\DSS\"
If Dir(DSS, vbDirectory) = "" Then  MkDir DSS

ThisWorkbook.SaveCopyAs DSS & "BD2.xlsm"    ' Enregistre avec les macros
End Sub

Mon observation pour le stockage de fichiers sur le bureau reste valable.

Bonne journée

re,

Bonjour Eric,Angers.

justement. Hier Dan, m'a fait la remarque.

j' étais embrouillé. J'ai fouillé en vain. Pourtant c'était juste à côté.

Pour la remarque suivante:

L'inconvénient dans votre code, c'est que l'instruction Add ajoute un classeur avec un nombre de feuilles prédéterminé dans les options d'Excel. Si l'option est fixée à 3 feuilles, et que le classeur BD en contient 5, le classeur BD2 contiendra 8 feuilles.

l'objectif était justement de copier spécifiquement certains classeur du fichier BD et les coller dans le classeur DSS. étant débutant en programmation, je me suis casser la tête mais j'ai pu écrire ce code. J'ai alors opté pour la copie de toutes les feuil du classeur BD. ce qui aboutit à votre pertinente remarque. Mais s'il y a possibilité de le faire, je suis preneur

Mon observation pour le stockage de fichiers sur le bureau reste valable.

ici aussi, je vais opter d'enregistrer le fichier ailleurs et créer un raccourci pour l'accès, c'est beaucoup plus à l' abri de la suppression par erreur.

merci bien pour les remarques

Re

On peut modifier le nbre de feuilles défini dans les options Excel et le rétablir ensuite.

Voici votre code revu :

Sub CopierFeuillesEtEnregistrer()
    Dim BD As Workbook
    Dim BD2 As Workbook
    Dim DSS As String
    Dim cheminBD2 As String
    Dim feuille As Variant
    Dim Nbre_Feuilles As Integer

    Nbre_Feuilles = Application.SheetsInNewWorkbook ' Sauve le nbre de feuilles par défaut
    Application.SheetsInNewWorkbook = 1             ' Positionne à 1 seule feuille (1 minimum)

    Set BD = Workbooks("BD.xlsm")
    Set BD2 = Workbooks.Add                         ' Nouveau classeur avec 1 seule feuille
    BD2.Sheets(1).Name = "xx"                       ' Renomme la feuille 1 pour suppression ensuite

    For Each feuille In BD.Sheets
        feuille.Copy After:=BD2.Sheets(BD2.Sheets.Count)
    Next feuille

    Application.DisplayAlerts = False               ' Pas de confirmation
    BD2.Sheets("xx").Delete                         ' Supprime la feuille 1
    Application.DisplayAlerts = True                ' Rétablit confirmation

    Application.SheetsInNewWorkbook = Nbre_Feuilles ' Rétablissement du nbre de feuilles par défaut

    DSS = Environ$("USERPROFILE") & "\Desktop\DSS\"
    If Dir(DSS, vbDirectory) = "" Then
        MkDir DSS
    End If

    cheminBD2 = DSS & "BD2.xlsm"
    BD2.SaveAs cheminBD2, FileFormat:=52
End Sub

Bonne journée