Distribution automatique de fichier dans dossiers selon liste filtrée

Bonjour le Forum,

Me voilà a nouveau devant un dilemme. je dois distribuer des fichiers dans des centaines de dossiers sur un serveur(Adresse des dossiers en colonne DL). Comme certains dossier ne doivent pas recevoir certains fichier, Je cherche a filtrer par le code ci-dessous pour que le fichier ne soit distribué que sur les lignes marquées par (XOui) dans la 5ème colonne nommée "Conformité".

Quelqu'un pourrait éclairer ma lanterne, un grand merci d'avance

Andreas

Sub Copier_le_fichier_vers_00() 'Index est la colonne du 1er dossier de destination

    Application.ScreenUpdating = False
    Dim Donnees As Worksheet, DerniereLigne&, i&, repdest As String
    Dim FileSource As String
    Dim FileDest As Variant
    Dim Fichier As String
    Dim NomFic As String

    ChDir "N:\11_FS_West\40_Conformité_West\Documents pour classeurs conformité"
    FileSource = Application.GetOpenFilename("Tous les fichiers (*.*),*.*") 'c'est ici que le choix du fichier a copier doit se faire
    NomFic = Split(FileSource, "\")(UBound(Split(FileSource, "\"))) 'copie que le nom du fichier avec extention
    Set Donnees = ThisWorkbook.Sheets("Base")
    DerniereLigne = Donnees.Cells(Rows.Count, 2).End(xlUp).Row
     For i = 2 To DerniereLigne
            FileDest = NomFic '("Exemple de nom de fichier.pptx")
            repdest = Donnees.Range("DL" & i).Value
            If Dir(repdest, vbDirectory) <> "" Then 'vérifie que le répertoire de destination existe
                FileCopy FileSource, repdest & FileDest
            End If
     Next i
MsgBox "Le fichier a été distribué avec succès, action Terminée"
End Sub

Bonjour,

N'ayant pas de réponse, je suppose que je pose mal ma question?

Bonjour,

Voici un essai si j'ai bien compris :

     For i = 2 To DerniereLigne
        if Donnees.Range("E" & i).Value = "XOui" then
            FileDest = NomFic '("Exemple de nom de fichier.pptx")
            repdest = Donnees.Range("DL" & i).Value
            If Dir(repdest, vbDirectory) <> "" Then 'vérifie que le répertoire de destination existe
                FileCopy FileSource, repdest & FileDest
            End If
        end if
     Next i

J'ai donc rajouté une condition afin d'effectuer la copie que lorsque que la valeur en colonne E est "XOui".

Ici, on est d'accord, vous copiez un unique fichier vers une multitude de dossiers ?!

Cdlt,

Bonjour 3GB,

Milles Mercis, c'est exactement ça, je n'arrivais pas a trouver ce code et c'est pas faute d'avoir essayé.

Je vous suis vraiment reconnaissant.

Cordialement

Andreas