VBA copie de fichier dans des répertoire

Bonsoir,

Dans le code suivant, la loop ne focntionne pas , il copie uniquement le premier fichier.

Avez-vous une idée

Merci

Sub repCopierFichier()

Dim fso As Object, Dossier_cherché$, Dossier_récepteur$, Fichier_cherché$

Set fso = CreateObject("Scripting.FileSystemObject")

Dossier_récepteur = Range("D12")

Range("B12").Activate

Do Until ActiveCell = ""

Dossier_cherché = ActiveCell

Fichier_cherché = ActiveCell.Offset(0, 1)

fso.CopyFile Dossier_cherché & "/" & Fichier_cherché, Dossier_récepteur & "/" & Fichier_cherché

ActiveCell.Offset(1, 0).Activate

Loop

End Sub

Bonjour,

Je pense que vous avez inversé les "\" avec des "/", à moins que vous ne soyez sur mac, auquel cas le filesystemobject n'est pas disponible en principe.

A priori rien de vraiment nouveau dans ce code, à part quelques conditions permettant d'éviter des bugs (et les antislash et le remplacement des activecell) :

Sub repCopierFichier()

Dim fso As Object
Dim Dossier_récepteur$, Dossier_cherché$, Fichier_cherché$, pathorigine$, pathdest$

Set fso = CreateObject("Scripting.FileSystemObject")
Dossier_récepteur = Range("D12")
i = 12
While range("B" & i) <> ""
    Dossier_cherché = range("B" & i)
    Fichier_cherché = range("C" & i)
    pathorigine = Dossier_cherché & "\" & Fichier_cherché
    pathdest = Dossier_récepteur & "\" & Fichier_cherché
    if fso.fileexists(pathorigine) then 'si fichier origine existe
        if fso.fileexists(pathdest) then 'si fichier destination existe
            fso.getfile(pathdest).attributes = 0 'attribut lecture seule (du fichier à remplacer) sur faux
        end if
        fso.CopyFile pathorigine, pathdest 'copie fichier, écrasant le cas échéant le fichier du même nom
    end if
    i = i + 1
wend

End Sub

Cdlt,

Bonjour, merci pour la réponse, mais j'ai toujours le même problème, seul le pr

emier dossier a été alimenté et non les autres. un idée ??

Bonjour,

L'exemple n'est pas très parlant. Forcément, seul un fichier est copié puisque toutes les lignes en C contiennent le même nom de fichier. Il faudrait que vous essayiez avec des noms de fichiers différents.

Cdlt,

Exact, mais mon souhait est de dupliquer le fichier issu du répertoire FBL3N dans chaque répertoire créé. Comment faire

Au temps pour moi, comme le dossier récepteur était fixe dans le code, je n'ai pas fait attention.

Chez moi ça fonctionne bien en incluant la colonne D dans la boucle (car le dossier récepteur est variable). Il faudra faire attention à ne pas mettre d'antislash à la fin du dossier récepteur (sur la feuille) car le code en ajoute un :

Sub repCopierFichier()

Dim fso As Object
Dim Dossier_récepteur$, Dossier_cherché$, Fichier_cherché$, pathorigine$, pathdest$

Set fso = CreateObject("Scripting.FileSystemObject")

i = 12
While Range("B" & i) <> ""
    Dossier_cherché = Range("B" & i)
    Fichier_cherché = Range("C" & i)
    Dossier_récepteur = Range("D" & i)
    pathorigine = Dossier_cherché & "\" & Fichier_cherché
    pathdest = Dossier_récepteur & "\" & Fichier_cherché
    If fso.fileexists(pathorigine) Then 'si fichier origine existe
        If fso.fileexists(pathdest) Then 'si fichier destination existe
            fso.getfile(pathdest).Attributes = 0 'attribut lecture seule (du fichier à remplacer) sur faux
        End If
        fso.CopyFile pathorigine, pathdest 'copie fichier, écrasant le cas échéant le fichier du même nom
    End If
    i = i + 1
Wend

End Sub

Les lignes que j'ai ajoutées lors de ma première réponse n'ont probablement pas grande utilité dans votre cas mais elles ne sont pas bloquantes...

Cdlt,

Merci infiniment, c'est ce que je souhaitais. Bonne soirée