Via une liste excel transférer des fichiers dans un dossier windows

[jipi06]

Bonsoir

par VBA, je souhaite transférer/dispatcher les fichiers listés dans une feuille excel sur la colonne B dans le dossiers correspondants listés dans la colonne A.

J'ai plusieurs centaines de fichiers à dispatcher et j'aimerai le faire d'un coup !

Les fichiers à transférer sont stockés dans un dossier nommé TOTAL situé au même niveau d'arborescence que les dossiers listés dans la colonne A.

La feuille excel comportant ces infos est stockée au même endroit.

Je joint un fichier exemple.

Merci de votre aide

jipi06

 

[sousou]

bonjour
ici un code à tester . pense à mettre le chemin de ton arborescence à la place de' ici le chemin'
Sub deb()
chemin = "ici le chemin" & "\"
drlg = dernièrelg(Sheets("transfert"), 2)
Set fso = CreateObject("scripting.filesystemobject")

With Sheets("transfert")
For n = 2 To drlg
Set fich = fso.getfile(chemin & "total\" & .Cells(n, 2))
fich.Move (chemin & .Cells(n, 1) & "\")
Next
End With
End Sub
'calcule la dernière ligne de la base
'feuille=objetfeuille, col= numéro de colonne, ligne ligne de départ)
Function dernièrelg(feuille, col, Optional lgd As Integer = 1)

With feuille
Set k = .Cells(.UsedRange.Columns(col).Rows.Count + 1 + lgd, col).End(xlUp)
If k <> "" Then dernièrelg = k.Row + 1 Else dernièrelg = 1
End With
End Function

 

[job75]

Bonsoir jipi06, sousou,

Sub Transfert()
Dim dossier1$, dossier2$, fso As Object, tablo, i&
dossier1 = ThisWorkbook.FullName
dossier1 = Left(dossier1, InStrRev(dossier1, "\") - 1)
dossier2 = Left(dossier1, InStrRev(dossier1, "\"))
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
tablo = Sheets("Transfert").UsedRange.Resize(, 2)
For i = 2 To UBound(tablo)
    fso.movefile dossier1 & "\" & tablo(i, 2), dossier2 & tablo(i, 1) & "\" & tablo(i, 2)
Next
End Sub

Le fichier de la macro doit être dans le même dossier (TOTAL) que les fichiers de la colonne B.

A+

 

[jipi06]

Bonjour a @job75 @sousou

J'ai utilisé le code de @sousou.
Ça marche bien

Merci beaucoup à tous les deux.

Jipi06

 

[davidgau]

bonjour
ici un code à tester . pense à mettre le chemin de ton arborescence à la place de' ici le chemin'
Sub deb()
chemin = "ici le chemin" & "\"
drlg = dernièrelg(Sheets("transfert"), 2)
Set fso = CreateObject("scripting.filesystemobject")

With Sheets("transfert")
For n = 2 To drlg
Set fich = fso.getfile(chemin & "total\" & .Cells(n, 2))
fich.Move (chemin & .Cells(n, 1) & "\")
Next
End With
End Sub
'calcule la dernière ligne de la base
'feuille=objetfeuille, col= numéro de colonne, ligne ligne de départ)
Function dernièrelg(feuille, col, Optional lgd As Integer = 1)

With feuille
Set k = .Cells(.UsedRange.Columns(col).Rows.Count + 1 + lgd, col).End(xlUp)
If k <> "" Then dernièrelg = k.Row + 1 Else dernièrelg = 1
End With
End Function

bonjour
est ce que cela fonctionne sur Mac ?

 

[job75]

Bonjour davidgau,

Sur MAC il faut remplacer l'antislash \ par le slash /

Ou utiliser à la place Application.PathSeparator.

A+