VBA - Copier des fichiers dans différents dossiers donné dans une colonne

Bonjour,

Je suis novice en VBA et j'ai cherché un peu plusieurs codes pour copier des fichiers dans des dossiers.
J'ai trouvé plusieurs exemples mais en général les dossiers sources et destinations sont intégrés dans le VBA et non pris dans des colonnes.
J'aimerais pouvoir transférer des fichiers (dont la source est donnée par exemple en colonne A) dans différents dossiers (dont la destination est donnée en colonne B). Quelqu'un pourrait-il m'aider?

Voici une base sur laquelle j'ai essayé de chipoter mais je n'y arrive pas...

Code:

---

1 2 3 4 5

Sub CopierFichier() 'Copie le fichier dans un autre dossier: 'syntaxe : FileCopy "source", "destination" FileCopy "C:\dossier\general\excel\Classeur.xls", "D:\Classeur.xls" End Sub

---

Merci d'avance pour votre aide.

bonjour
qui y a til d'écrit textuellement en A et en B les chemin racine ou les chemin complets ????

Bonjour,

Merci pour le premier retour, je peux y mettre l'un ou l'autre, le plus simple je pense serait d'avoir
Colonne A: C:\Users\MOI\Documents\Client 1 - Photo1.JPG
et Colonne B: C:\Users\MOI\Autres\Client 1 - Photo1.JPG

re
dans ce cas la si le chemin est complet dans les deux c'est

Code:

---

FileCopy range("A" & i).text, range("B" & i).text

---

i étant itéré dans une boucle for i = premierlignedetaplage to dernierelignedetaplage

Salut.

Perso, je travaillerais avec une table de données... C'est tellement plus facile. Pas besoin de définir la plage à coup de range("A1048576").End(XlUp) (si tant est qu'on puisse), pas besoin de se tracasser du nombre de lignes, pas besoin de se tracasser de la position de la table sur une feuille particulière ni à un endroit particulier de la feuille. Que du bonheur!

Code:

---

1 2 3 4 5 6 7

Sub CopyFromTable() Dim Cell As Range   For Each Cell In Range("t_Fichiers[Source]") FileCopy Cell.Value, Cell(1, 2).Value Next End Sub

---

Pièce jointe 481867


Attention. Pour éviter une erreur, il serait bon de prévoir l'erreur, a minima avec un On Error Resume Next pour prévenir les fichiers inexistants ou impossible à copier, ainsi que les dossiers de destination inexistants, les problèmes de droit d'accès, ... Ca ne coûte pas plus cher. Ici, on colorie en rouge la cellule source de la ligne qui pose problème.

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub CopyFromTable() Dim Cell As Range   For Each Cell In Range("t_Fichiers[Source]") On Error Resume Next FileCopy Cell.Value, Cell(1, 2).Value If Err.Number <> 0 Then Cell.Interior.Color = vbRed End If Next End Sub

---

PS: Dans ce cas-ci, utiliser Range.Text plutôt que Range.Value ne sert strictement à rien.

Merci beaucoup à tous les deux!
Je vais tester ça immédiatement :)

Ca marche super bien, j'aime bien l'option qui met en évidence les erreurs je ne l'avais jamais utilisée et je pense l'intégrer dans plusieurs de mes macros, merci!

J'ai juste ajouté la vérification de la présence du dossier de destination (chemin mis en 3ème colonne) et de sa création s'il n'existe pas.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19

Sub CopyFromTable()   Dim Cell As Range   For Each Cell In Range("Tableau3[Source]") On Error Resume Next If Len(Dir(Cell(1, 3).Value, vbDirectory)) > 0 Then FileCopy Cell.Value, Cell(1, 2).Value Else MkDir (Cell(1, 3)) FileCopy Cell.Value, Cell(1, 2).Value End If If Err.Number <> 0 Then Cell.Interior.Color = vbRed End If Next     End Sub

---

Merci beaucoup pour votre aide.

Citation:

---

Envoyé par Pierre Fauconnier

Salut.

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub CopyFromTable() Dim Cell As Range   For Each Cell In Range("t_Fichiers[Source]") On Error Resume Next FileCopy Cell.Value, Cell(1, 2).Value If Err.Number <> 0 Then Cell.Interior.Color = vbRed End If Next End Sub

---

---

Je me demandais est-ce que ça serait possible de colorier en rouge la ligne à erreur plutôt que la première cellule? J'ai essayé de mettre Rows(Activecell.row).Interior.Color = vbRed mais ça me colorie la ligne de la cellule sélectionnée avant le démarrage de la macro...

Il faut changer la ligne 8 de mon code par Cell.EntireRow.Interior.Color = vbRedAttention que ça colorie TOUTE la ligne (sur 16384 colonnes). A toi d'adapter

Super merci beaucoup!