Discussion :

[Vulcaiiin]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[patricktoulon]

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

[Vulcaiiin]

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

[patricktoulon]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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

[Pierre Fauconnier]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[Vulcaiiin]

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

[Vulcaiiin]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[Vulcaiiin]

Salut.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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...

[Pierre Fauconnier]

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

[Vulcaiiin]

Super merci beaucoup!