Sub CreationRepertoires4()
'voir à cocher la référence Microsoft Scripting Runtime
Dim Chemin As String, NouveauChemin As String, Fichier As String
Dim oFSO As Scripting.FileSystemObject
Dim oDrv As Scripting.Drive
'Instanciation du FSO
Set oFSO = New Scripting.FileSystemObject
On Error Resume Next
i = 3
While Cells(i, 1).Value <> ""
MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value
On Error GoTo 0
For j = 2 To 9
' If Cells(i, j).Value = "" Then Exit Sub
MkDir ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value
Chemin = "\\xxhy93\donnees\USERS\ISMA2070\Documents\TEST" ' chemin a changer selon
NouveauChemin = ActiveWorkbook.Path & "\" & Cells(i, 1).Value & "\" & Cells(i, j).Value & "\"
If Cells(i, j) <> "" Then
Fichier1 = Cells(i, j) & ".pdf"
oFSO.CopyFile Chemin & "\" & Fichier1, NouveauChemin 'copie le fichier
End If
Next j
i = i + 1
Wend
End Sub