Function RepertExiste(NomDossier As String) As Boolean
RepertExiste = Dir(NomDossier, vbSystem + vbDirectory + vbHidden) <> ""
End Function
Function Path_Fich(Fich As String, Repert As Boolean)
Dim i As Integer
Dim Ts() As String, St As String
Ts = Split(Fich, "\")
'on extrait le répertoire
For j = 0 To UBound(Ts) - 1
St = St & Ts(j) & "\"
If Repert And Not RepertExiste(St) Then MkDir St
Next j
Path_Fich = St
'puis le nom du fichier
Fich = Ts(UBound(Ts))
End Function
Sub Copier_Fichiers()
Dim FSO As Object
Dim FichDep As String, FichArriv As String
Dim St As String, Ts() As String
Dim Rep_Dep As String, Rep_Arriv As String
Dim Derlig As Integer
Dim i As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
Sheets("Feuil1").Select
'donne la dernière ligne non vide en colonnes K
Derlig = Range("K" & Rows.Count).End(xlUp).Row
For i = 2 To Derlig
Rep_Dep = ""
Rep_Arriv = ""
If Range("K" & i) <> "" Then
'on prend le nom du fichier départ et le chemin en colonne K si la cellule n'est pas vide
FichDep = CStr(Range("K" & i))
Rep_Dep = Path_Fich(FichDep, False)
'on prend le nom du fichier et le chemin d'arrivée en colonne M
FichArriv = CStr(Range("M" & i))
Rep_Arriv = Path_Fich(FichArriv, True)
FSO.CopyFile Rep_Dep & FichDep, Rep_Arriv & FichArriv, True
End If
Next i
Set FSO = Nothing
End Sub