Copier Coller dossier et renommer selon plage de cellule

Bonjour à tous,

Complètement nouveau dans le monde de excel et des Macro je me retrouve face à un problème que mes maigres compétences ne peuvent pas résoudre

J'ai un dossier modèle que j'aimerais copier coller x fois dans un autre dossier et renommer en utilisant la valeur de chaque cellule de ma colonne D

J'ai donc fait quelques recherche, découvert les macro et j'ai "codé" le code suivant :

Sub CreerDossier()
    'On Error Resume Next
    Dim Nom As String
    Dim Fso As Object, Source As String, Destination As String
    Set Fso = CreateObject("Scripting.FileSystemObject")

    For Each c In Range("D:D")
    D .Name = c.Value

    Source = "J:\Paie\ZZZ. PROJET\TEST"
    Destination = "J:\Paie\ZZZ. PROJET\101. ADMINISTRATION DU PERSONNEL\Actifs\" & D. Name
    Fso.CopyFolder Source, Destination, False

 MsgBox "traitement ok"

 Next c

End Sub

qui comme vous vous en doutez ne fonctionne pas...

J'en appel donc à votre aide et à votre générosité pour m'aider à résoudre ce problème

Merci d'avance à tous ceux qui prendrons la peine de me lire

Bonjour

Ne veux-tu pas faire plutôt quelque chose comme cela ??

Sub CreerDossier()
    'On Error Resume Next
    Dim Nom As String

    For Each c In Range("D:D")
        If c.Value <> "" Then
            Nom = c.Value
            ThisWorkbook.SaveCopyAs "C:\Test\Class_Test_Actifs.xlsm"
            NewFile = "C:\Test\Class_Test_Actifs" & Nom & ".xlsm"
            Name "C:\Test\Class_Test_Actifs.xlsm" As NewFile
        End If
    Next c
  MsgBox "traitement ok"
End Sub

Bon courage

A+

Bonjour Patty,

Merci beaucoup pour ta reponse,

Si je comprend bien ta réponse me fais copier / coller un fichier excel avant de le renommer ?

Ca fonctionne si je le lève le .xlsm ? Car moi c'est un dossier windows que je veux copier coller

En fait ce que je veux faire c'est copier le dossier et le coller ailleurs puis le renommer pour créer un dossier par salarié pour pouvoir stocker des documents par salarié

Merci beaucoup

Bonjour

Tu sauvegardes ton fichier où tu veux, mets l'extension que tu veux

Cela devrait marcher

A+

Bonjour

J'ai fait cela avec un fichier texte

Sub CopierFichiers()
Dim Chemin As String, Fichier As String
Dim Destination As String
    'Répertoire contenant lee fichier à copier
    Chemin = "C:\Test\"
   'Répertoire recevant les fichiers
    Destination = "C:\Test\Projet\"
    Fichier = "MonDoc" & ".txt"
    Fich = "MonDoc"

    FileCopy Chemin & Fichier, Destination & Fichier 'copie les fichiers

    For Each c In Range("D:D")
        If c.Value <> "" Then
            Nom = c.Value
            NewFile = Destination & Fich & Nom & ".txt"
            FileCopy Destination & Fichier, NewFile
        End If
    Next c
End Sub

Cela fonctionne

Vois et dis-moi si tu peux l'adapter

Je crois que je m'exprime mal. Ou alors je n'arrive pas à l'adapter

En fait ce que je veux copier ce n'est pas un fichier Word Excel ou autre c'est un dossier (comme l'image jointe à ce message)

Pour pouvoir créer un dossier par salarié et plus tard y stocker des fichiers.

Merci encore pour ton aide

capture

Re re

Essaie cela

Sub CreerDossier()
    'On Error Resume Next
    Dim Nom As String
    Dim Fso As Object, Source As String, Destination As String
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set sh = Sheets(2)
    vv = sh.Cells(3, 3)
    For Each c In sh.Range("D:D")
        If c.Value <> "" Then
            Nom = c.Value
            Source = "C:\Paie\ZZZ. PROJET\TEST"
            Destination = "C:\Paie\ZZZ. PROJET\101. ADMINISTRATION DU PERSONNEL\Actifs\" & Nom
            Fso.CopyFolder Source, Destination, False
        End If
 Next c
  MsgBox "traitement ok"

End Sub

A ce niveau, met la feuille du classeur qui contient tes données en D

Set sh = Sheets(2)

Vois si cette fois j'ai compris

A+

Bonjour,

C'est parfait !! Ça à marché du feu de dieux !!

Un immense merci ! Tu es génial !!!

Je te souhaite une bonne fin de journée et encore merci

Rechercher des sujets similaires à "copier coller dossier renommer plage"