Distribution de fichiers dans des dossiers differents VBA

Bonjour à tous, déjà un grand merci aux connaisseurs pour la qualité des soutiens.

Etant un profane en matière VBA j'ai vraiment besoin de vos connaissance.

Pour en venir a mon besoin, je cherche depuis plus d'une semaine une solution pour:

Via VBA, choisir un fichier (de type divers)dans un dossier précis, et le recopier(Coller son raccourci) dans chaque dossier selon une base de données (Adresses des dossiers/répertoires).

Structure des dossiers:

Lecteur/plusieurs dossiers région/ environ 700 dossiers bâtiments/20 répertoires (Identique à chaque bâtiments)

La base de données:

Chaque ligne d'un bâtiment contient plusieurs colonne avec les adresses sur serveur pour chaque répertoire (De 1-20)

But final:

en choisissant le fichier a copier, sélectionner le répertoire final, et le code va placer une copie dans chaque bâtiment/Répertoire

Milles mercis d'avance

Andreas

Rebonjour,

En faite, j'aimerais qu'après avoir choisi un fichier (Boite dialogue), celui-ci soit enregistré a l'adresse mentionnée dans la cellule B2

La colonne B contient les adresses de tous les dossiers cible.

Donc avec une boucle jusqu’à la ligne 700.

Merci d'avance

Re,

j'ai trouver et compilé quelque chose, mais ça ne fonctionne pas!

Sub Copier_le_fichier_vers_Index() '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 String
    Dim Fichier As Variant

    FileSource = Application.GetOpenFilename("Tous les fichiers (*.*),*.*") 'c'est ici que le choix du fichier a copier doit se faire

    Set Donnees = ThisWorkbook.Sheets("Base")
    DerniereLigne = Donnees.Cells(Rows.Count, 112).End(xlUp).Row
    For i = 2 To 3 'DerniereLigne '700 ici 3 pour test

        If Dir(FileSource) <> "" Then 'vérifie que le fichier source existe
            FileDest = Donnees.Range("DH" & i).Value 'DH est la colonne adresses des dossiers de destination
            repdest = Left(FileDest, InStrRev(FileDest, "\") - 1)
            If Dir(repdest, vbDirectory) <> "" Then 'vérifie que le répertoire de destination existe
                FileCopy FileSource, FileDest
            Else
                MsgBox "je ne trouve pas le répertoire " & repdest
            End If
        Else
            MsgBox " je ne trouve pas le fichier " & FileSource
        End If
    Next i

End Sub

Avec une impression de monologue...

j'ai trouvé mon bonheur :

Sub Copier_le_fichier_vers_Index() '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 "chemin complet du dossier ou choisir le fichier"
    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 2 'DerniereLigne

            FileDest = NomFic '("nom du fichier choisi")
            repdest = Donnees.Range("DH" & i).Value
            If Dir(repdest, vbDirectory) <> "" Then 'vérifie que le répertoire de destination existe
                FileCopy FileSource, repdest & FileDest
            End If
     Next i

End Sub

Merci quand même, sans les codes déjà présents, je n'y serais jamais arrivé.

A tout bientôt

Andreas

Hello la helpline!

De retour avec un petit souci.

J'aimerais pouvoir sélectionner plusieurs fichiers en sélection

Puis dans la distribution, filtrer les lignes source par un "Oui" de la colonne "conformité"

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:\32_Transfer\Mon nom\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 son extension
    Set Donnees = ThisWorkbook.Sheets("Base")
    DerniereLigne = Donnees.Cells(Rows.Count, 2).End(xlUp).Row
     For i = 2 To 2 'DerniereLigne

            FileDest = NomFic '("exemple de nom de fichier.pptx")
            repdest = Donnees.Range("DH" & i).Value
            If Dir(repdest, vbDirectory) <> "" Then 'vérifie que le répertoire de destination existe
                FileCopy FileSource, repdest & FileDest
            End If
     Next i

End Sub

Ou dois-je mettre quoi?

Merci d'avance

Andreas