Ajouter fichier pdf dans dossier

bonjour a tous et toutes

j'ai une petite macro qui me permet de créer des dossier avec le nom et prénom et je voulais savoir si il est possible d'y joindre un fichier pdf choisi.

en gros ajouter le fichier PDF qui ce trouve dans c:/mes documents/toto.pdf dans le dossier truc-much.

Merci de votre aide

Voici ma macro

Sub CreationRepertoires()
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        For j = 2 To 11
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
        Next j
        i = i + 1
    Wend
End Sub

bonjour,

essaie ceci

Sub CreationRepertoires()
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        For j = 2 To 11
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
            filecopy  " c:\mes documents\toto.pdf"  ,ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
        Next j
        i = i + 1
    Wend
End Sub

Merci pour cette idée

J'ai trouver une macro qui peut m'aider mais commen faire pour recuperer le nom du fichier qui ce trouve en b1 et le deposer dans le dossier A1 etc

si joint mon fichier test .

Merci de votre aide

rebonjour a tous

je suis toujours sur mon problème j'ai réussi une macro qui fonctionne mais je ne vois pas comment spécifier le dossier de destination

Sub Fichier1()

    Dim GestionFichier As Object
    Set GestionFichier = CreateObject("Scripting.FileSystemObject")
    GestionFichier.CopyFile "\\xxhy93\donnees\USERS\ISMA2070\Documents\TEST\CRSCGL-234.pdf", "\\xxhy93\donnees\USERS\ISMA2070\Documents\TEST\ici le dossier de destination est indiquer en A1
        Set GestionFichier = Nothing

End Sub

une idée peut etre?

Sub Fichier1()

    Dim GestionFichier As Object
    Set GestionFichier = CreateObject("Scripting.FileSystemObject")
    GestionFichier.CopyFile "\\xxhy93\donnees\USERS\ISMA2070\Documents\TEST\CRSCGL-234.pdf", "\\xxhy93\donnees\USERS\ISMA2070\Documents\TEST\" & range("A1")
        Set GestionFichier = Nothing

End Sub

bonsoir

grâce a gilbert_RGI d'un autre forum

j'ai presque trouvez la solution il ne me reste plus que deux ou trois détail.

je reussi a copier les fichier mais comment faire pour choisir quel fichier a copier selon ce qui est indiquer dans le classeur excel

ci joint mon fichier (ce sera plus clair)

je reste en ligne alors n’hésiter pas.

Merci de votre aide

bonsoir

Sub CreationRepertoires()
    On Error Resume Next
    i = 1
    While Cells(i, 1).Value <> ""
on error resume next
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
on error goto 0
        For j = 2 To 11
         if cells(i,j)<>"" then  filecopy  " c:\mes documents\" & cells(i,j) & ".pdf" ,ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & ".pdf"
        Next j
        i = i + 1
    Wend
End Sub

bonsoir h2so4

cela ne fonctionne pas message d'erreur .

de plus a tu ouvert mon fichier ?

Sub CreationRepertoires3()

'voir à cocher la référence Microsoft Scripting Runtime

    Dim Chemin As String, NouveauChemin As String, Fichier As String
    Dim oFSO As Scripting.FileSystemObject
    Dim oDrv As Scripting.Drive
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject

    On Error Resume Next
    i = 3
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        On Error GoTo 0
        For j = 2 To 9
           ' If Cells(i, j).Value = "" Then Exit Sub
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
            Chemin = "C:\Users\Documents\test copie et dossier" ' chemin a changer selon 

            NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"

 'C'EST LA QUE JE BLOQUE

'je voudrais récupérer la valeur de la cellule  (si il y a  CRSCGL-234) alors on copie le fichier dans le dossier concerner sinon on passe au suivant.

            Fichier1 = "crscgt-234.pdf" 'ici voudrais mettre une variable qui pointe vers la cellule désignant le nom du fichier

            oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier

        Next j
        i = i + 1
    Wend
End Sub

car le codage n'est plus le même.

mais merci tout de même pour ton aide

Sub CreationRepertoires3()

'voir à cocher la référence Microsoft Scripting Runtime

    Dim Chemin As String, NouveauChemin As String, Fichier As String
    Dim oFSO As Scripting.FileSystemObject
    Dim oDrv As Scripting.Drive
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject

    On Error Resume Next
    i = 3
    While Cells(i, 1).Value <> ""
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        On Error GoTo 0
        For j = 2 To 9
           ' If Cells(i, j).Value = "" Then Exit Sub
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
            Chemin = "C:\Users\Documents\test copie et dossier" ' chemin a changer selon 

            NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"

 'C'EST LA QUE JE BLOQUE

'je voudrais récupérer la valeur de la cellule  (si il y a  CRSCGL-234) alors on copie le fichier dans le dossier concerner sinon on passe au suivant.
           if cells(i,j)<>"" then
            Fichier1 = cells(i,j) & ".pdf" 'ici voudrais mettre une variable qui pointe vers la cellule désignant le nom du fichier

            oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier

          end if
        Next j
        i = i + 1
    Wend
End Sub

merci h2so4

Maintenant j'ai un message d'erreur (fichier introuvable) car je n'est pas fini de tout scanner .

est t'il possible a la place de ce message d'erreur d'avoir un message genre "fichier "NOM DU FICHIER" non trouver et continuer la macro.

de plus si la cellule est vide j'ai une erreur aussi.

Mais déjà un GROS MERCI POUR TON AIDE .

bonjour,

un nouvel essai

Sub CreationRepertoires3()

'voir à cocher la référence Microsoft Scripting Runtime

    Dim Chemin As String, NouveauChemin As String, Fichier As String
    Dim oFSO As Scripting.FileSystemObject
    Dim oDrv As Scripting.Drive
    'Instanciation du FSO
    Set oFSO = New Scripting.FileSystemObject

    i = 3
    While Cells(i, 1).Value <> ""
        On Error Resume Next 'si le répertoire existe déjà
        MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
        On Error GoTo 0
        For j = 2 To 9
        If Cells(i, j).Value <> "" 
            on error resume next ' si le répertoire existe déjà
            MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
            on error goto 0            
            Chemin = "C:\Users\Documents\test copie et dossier" ' chemin a changer selon 

            NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"

            Fichier1 = cells(i,j) & ".pdf" 'ici voudrais mettre une variable qui pointe vers la cellule désignant le nom du fichier
            if dir(chemin & "\" & fichier1)<>"" then
            oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier
            else
            msgbox "fichier " & fichier1 & " non trouvé"
           end if
          end if

        Next j
        i = i + 1
    Wend
End Sub

super un gros merci

et VIVE LA BELGIQUE